Assignment 3: Dimensionality Reduction
Lau Wen Jun
2023-04-10
1 Parkinson’s Disease example
Use Principal Component Analysis (PCA), Singular Value Decomposition (SVD), Independent component analysis(ICA), Factor analysis (FA) to reduce the dimensionality of the PD data. Interpret each of the results.
library(xml2)
library(rvest)
library(plotly)
library("devtools")
devtools::install_github("kassambara/factoextra")
library("factoextra")
pd<-read_html('https://wiki.socr.umich.edu/index.php/SOCR_Data_PD_BiomedBigMetadata')
html_nodes(pd, "#content")## {xml_nodeset (1)}
## [1] <div id="content" class="mw-body" role="main">\n\t\t\t<a id="top"></a>\n\ ...pd<- html_table(html_nodes(pd, "table")[[1]])##PCA
pd$Dx <- gsub("PD", 1, pd$Dx)
pd$Dx <- gsub("HC", 0, pd$Dx)
pd$Dx <- gsub("SWEDD", 0,pd$Dx)
pd$Dx <- as.numeric(pd$Dx)
pd<-pd[, -c(1, 33)]
pca <- princomp(pd, cor=TRUE)
summary(pca) ## Importance of components:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5
## Standard deviation 1.39495952 1.28668145 1.28111293 1.2061402 1.18527282
## Proportion of Variance 0.06277136 0.05340481 0.05294356 0.0469282 0.04531844
## Cumulative Proportion 0.06277136 0.11617617 0.16911973 0.2160479 0.26136637
## Comp.6 Comp.7 Comp.8 Comp.9 Comp.10
## Standard deviation 1.15961464 1.135510 1.10882348 1.0761943 1.06687730
## Proportion of Variance 0.04337762 0.041593 0.03966095 0.0373611 0.03671701
## Cumulative Proportion 0.30474399 0.346337 0.38599794 0.4233590 0.46007604
## Comp.11 Comp.12 Comp.13 Comp.14 Comp.15
## Standard deviation 1.05784209 1.04026215 1.03067437 1.0259684 0.99422375
## Proportion of Variance 0.03609774 0.03490791 0.03426741 0.0339552 0.03188648
## Cumulative Proportion 0.49617378 0.53108169 0.56534910 0.5993043 0.63119078
## Comp.16 Comp.17 Comp.18 Comp.19 Comp.20
## Standard deviation 0.97385632 0.96688855 0.92687735 0.92376374 0.89853718
## Proportion of Variance 0.03059342 0.03015721 0.02771296 0.02752708 0.02604416
## Cumulative Proportion 0.66178421 0.69194141 0.71965437 0.74718145 0.77322561
## Comp.21 Comp.22 Comp.23 Comp.24 Comp.25
## Standard deviation 0.88924412 0.87005195 0.86433816 0.84794183 0.82232529
## Proportion of Variance 0.02550823 0.02441905 0.02409937 0.02319372 0.02181351
## Cumulative Proportion 0.79873384 0.82315289 0.84725226 0.87044598 0.89225949
## Comp.26 Comp.27 Comp.28 Comp.29 Comp.30
## Standard deviation 0.80703739 0.78546699 0.77505522 0.76624322 0.68806884
## Proportion of Variance 0.02100998 0.01990188 0.01937776 0.01893963 0.01527222
## Cumulative Proportion 0.91326947 0.93317135 0.95254911 0.97148875 0.98676096
## Comp.31
## Standard deviation 0.64063259
## Proportion of Variance 0.01323904
## Cumulative Proportion 1.00000000#At around the first 18 principal components explain 72% of the variation. This is an acceptably large percentage.
fviz_pca_biplot(pca, axes = c(1, 2), geom = "point",
col.ind = "black", col.var = "steelblue", label = "all",
invisible = "none", labelsize = 2, pointsize = 2, repel = F, habillage = pd$Sex, palette = NULL, addEllipses = TRUE, title = "PCA - Biplot")
# Similar features/ scores of principal component are closer to each other. The magnitude projection/direction represents positive and negative association of Dimension. For example, R_Putamen Volume is positive associated with Dim2 but negative associated with Dim1. The points are coloured and grouped by gender. Visually, Male (Blue) has higher score of Dim2 than Female (Red) although their diffrence is not significant for Dim1.
plot_ly(x = c(1:length(pca$sdev)), y = pca$sdev*pca$sdev, name = "Scree", type = "bar") %>%
layout(title="Scree Plot", xaxis = list(title="PC's"), yaxis = list(title="Variances (SD^2)"))# Variance decrease with more principal components involved.
scores <- pca$scores
loadings <- pca$loadings
scaleLoad <- 10
p <- plot_ly() %>%
add_trace(x=scores[,1], y=scores[,2], z=scores[,3], type="scatter3d", mode="markers", name=pd$Dx,
marker = list(color=pd$Dx, colorscale = c("gray", "red"), opacity = 0.7), showlegend=F)
for (k in 1:nrow(loadings)) {
x <- c(0, loadings[k,1])*scaleLoad
y <- c(0, loadings[k,2])*scaleLoad
z <- c(0, loadings[k,3])*scaleLoad
p <- p %>% add_trace(x=x, y=y, z=z, type="scatter3d", mode="lines",
name=paste0("Loading PC ", k, " ", colnames(pd)[k]), line=list(width=8), opacity=1)
}
p <- p %>%
layout(legend = list(orientation = 'h'),
title=paste0("3D Projection of ", length(pca$sdev),"D PD Data along First 3 PCs (Colored by Dx)"))
p#Although not distinctive, the red and gray markers were separated by Y-axis (second principal component)## SVD
zvars<-scale(pd)
z.svd<-svd(zvars)
z.svd$d/sqrt(nrow(pd)-1)## [1] 1.3949595 1.2866814 1.2811129 1.2061402 1.1852728 1.1596146 1.1355100
## [8] 1.1088235 1.0761943 1.0668773 1.0578421 1.0402622 1.0306744 1.0259684
## [15] 0.9942238 0.9738563 0.9668886 0.9268774 0.9237637 0.8985372 0.8892441
## [22] 0.8700520 0.8643382 0.8479418 0.8223253 0.8070374 0.7854670 0.7750552
## [29] 0.7662432 0.6880688 0.6406326z.svd$v## [,1] [,2] [,3] [,4] [,5]
## [1,] -0.124726889 0.171520917 -0.207698342 0.2696940060 -0.03514716
## [2,] -0.160350863 -0.122820489 -0.048389962 0.3492630117 0.04321114
## [3,] -0.119968795 0.042043969 0.072224364 -0.1258861652 -0.24536328
## [4,] -0.048452104 -0.178282674 -0.128494946 0.1873141188 -0.02719269
## [5,] 0.112258314 0.214334338 -0.383213875 -0.0895576878 0.09900782
## [6,] -0.002621986 -0.133484674 -0.094326816 -0.4364647070 -0.15483421
## [7,] -0.162651540 -0.043902160 -0.197033470 -0.1718745097 -0.14488319
## [8,] 0.184478745 0.433945587 -0.101921501 -0.0700731158 -0.16390281
## [9,] 0.001927801 0.278690194 0.058267919 -0.0746696615 0.17851736
## [10,] -0.029095301 0.056518765 0.169254759 -0.2718217042 -0.07252699
## [11,] -0.165175280 -0.012022057 -0.058769583 -0.0088742612 -0.04827646
## [12,] -0.234487029 -0.260620392 -0.096727359 -0.0542797881 0.28114571
## [13,] 0.042176667 -0.058018186 0.177442557 0.0002055726 -0.11955136
## [14,] 0.035055806 -0.089089365 0.368110224 0.0455236125 0.12830579
## [15,] -0.005237879 -0.368763318 -0.134324207 0.0294342413 -0.03196249
## [16,] -0.060814192 0.159262984 -0.102847954 0.2819372436 -0.15050584
## [17,] 0.048585764 0.069071617 -0.102924103 0.1827919145 -0.10659484
## [18,] 0.111012683 -0.078404326 0.161514046 0.1216772432 -0.19373855
## [19,] -0.051033369 0.192308841 -0.015692110 0.1682676694 -0.22237217
## [20,] 0.014013178 -0.099504825 -0.206959459 0.0366528925 0.20569161
## [21,] -0.084447516 0.073661573 -0.168364008 0.2159381310 0.39365819
## [22,] -0.102561483 -0.172584400 -0.011971992 0.2273288121 -0.40801740
## [23,] 0.025655811 0.324509150 0.207311466 0.0838750312 0.09807992
## [24,] 0.082110125 -0.153604146 -0.150267410 -0.1569759760 0.08780654
## [25,] 0.017926755 -0.199736733 -0.141769183 -0.1601870028 -0.22347777
## [26,] 0.529205990 -0.171136515 -0.016101076 0.1190850138 -0.08435556
## [27,] 0.179940303 -0.073252603 0.426266410 0.0901749749 0.11242325
## [28,] -0.328704362 0.001391286 0.307550208 -0.0055498952 -0.11102501
## [29,] -0.315173680 -0.097343962 0.129275993 0.0348181191 0.24540513
## [30,] 0.193582492 -0.175090349 -0.012588491 0.3122151045 -0.09440298
## [31,] 0.422957832 -0.098837533 0.006513844 -0.0436413622 0.22539596
## [,6] [,7] [,8] [,9] [,10]
## [1,] 0.1193788468 0.011896366 -0.166624872 -0.351499809 0.1012283955
## [2,] 0.0001512498 0.272731860 0.125869982 0.005646878 0.0544857488
## [3,] -0.3746784194 0.199148199 -0.092110323 0.078980845 -0.0684488606
## [4,] -0.4412562621 -0.013019729 -0.162015868 -0.038477298 0.0713194411
## [5,] -0.1812156999 -0.044137411 0.126994472 -0.034688804 -0.0601921976
## [6,] -0.2082993045 0.087409151 -0.006990278 0.021260698 0.1686433499
## [7,] -0.2078801319 -0.036937306 0.239181919 -0.347566960 0.0710903475
## [8,] -0.0029299387 -0.096760562 0.145613307 -0.116627138 0.1291926360
## [9,] -0.2825481606 -0.102640636 0.065742968 0.291072624 -0.0030885892
## [10,] 0.1868597996 0.272696495 -0.188079057 -0.033480112 0.0001874029
## [11,] -0.2048310015 -0.446700856 -0.162313704 0.159954898 0.2759146623
## [12,] -0.1515506952 0.013128258 0.054817391 -0.250618378 0.2024943631
## [13,] 0.1188148492 -0.130064631 0.493468068 0.086304929 0.0069647767
## [14,] 0.0914106373 -0.233898905 0.054030626 -0.229060543 -0.0630931999
## [15,] 0.0460293455 -0.370357706 0.169773652 -0.062785179 -0.1183079108
## [16,] 0.1741874282 0.121924333 -0.003126492 0.261651123 0.2135692857
## [17,] -0.0177952922 0.105346856 -0.214328523 -0.134495128 0.2647223835
## [18,] -0.0125854435 0.186066803 0.096737684 -0.282691044 0.4372898079
## [19,] 0.0165566508 -0.472405522 -0.020433159 0.038923948 0.1325043884
## [20,] 0.1074378634 -0.097254127 -0.239984221 -0.187264888 -0.2936266162
## [21,] -0.0083624094 0.047280684 0.226415855 0.178069241 0.1253654151
## [22,] -0.0620932326 0.084693571 0.184390351 -0.018578135 -0.2679231430
## [23,] -0.0704267987 -0.003766098 0.153626821 -0.214154022 0.0053041843
## [24,] 0.3449546805 -0.103749493 -0.262393163 0.059197484 0.2869926967
## [25,] 0.2578357486 -0.033062288 0.182740153 0.206680857 0.2812797953
## [26,] -0.1504412266 -0.019427934 0.050422616 -0.022723953 -0.0521649634
## [27,] -0.1382493452 -0.144114765 -0.101070038 -0.159261713 0.2105988121
## [28,] -0.0784926244 -0.098566294 -0.245466936 0.139244608 0.0079280125
## [29,] -0.0298020028 0.110560978 0.235652724 0.153806976 0.1884700452
## [30,] -0.1147231706 0.022427495 -0.171235383 0.289453890 -0.0622135324
## [31,] -0.1673150941 0.117686280 0.021972982 0.121013640 0.2044788170
## [,11] [,12] [,13] [,14] [,15]
## [1,] 0.032107952 0.12924287 0.0823799113 -0.0428072124 -0.156864722
## [2,] -0.041874739 0.05994771 -0.0139663541 0.1327164607 0.541590157
## [3,] 0.075454499 -0.21110548 -0.1171867789 0.2575081834 0.081481702
## [4,] -0.005460335 0.40217076 -0.0978561405 -0.1250704680 0.042849973
## [5,] -0.029833887 -0.30047737 0.0008814869 -0.0106022422 0.015074169
## [6,] 0.131968158 0.04265047 0.0329848163 -0.2026846680 -0.259240087
## [7,] -0.213334738 0.08707133 0.1784987375 0.3655019454 0.095195391
## [8,] -0.157477719 -0.12601181 0.1366218137 -0.1662551647 0.128193843
## [9,] -0.361855301 -0.06085003 -0.0953793888 -0.1652285614 -0.025985370
## [10,] 0.014290263 -0.05773194 -0.4734058562 -0.1179384850 0.074955861
## [11,] 0.014274289 -0.13084136 -0.0048890220 0.1209842938 0.202268761
## [12,] -0.046550043 -0.09611420 -0.0775226766 -0.2664980260 -0.030068506
## [13,] -0.280559151 0.07315141 -0.3773335962 0.2710664800 -0.069269422
## [14,] 0.099722675 -0.38391205 0.3106836653 -0.1063701889 0.055629764
## [15,] 0.200354253 -0.10952156 -0.0890118275 -0.0260859500 -0.149678688
## [16,] -0.140352753 0.07337029 0.2823520705 0.0146528823 -0.278333140
## [17,] 0.201856488 -0.39765154 -0.2430340813 0.3878249746 -0.320218129
## [18,] -0.253145871 -0.13581357 -0.1371870130 -0.3855742672 0.046650084
## [19,] 0.052459629 0.10691900 -0.2982680744 -0.1419125631 -0.011329527
## [20,] -0.434219970 0.04205235 -0.2756392262 0.0437769857 -0.199409529
## [21,] 0.302297116 -0.17977392 -0.2693600638 -0.0995042155 0.134476003
## [22,] -0.103526396 -0.30142971 -0.0193618159 -0.1206453174 -0.009789851
## [23,] 0.276885963 0.25149838 -0.1394575121 0.0618664243 -0.072833664
## [24,] -0.229746471 -0.10600186 -0.0029041102 0.1187424443 0.277244671
## [25,] 0.187693429 0.18486499 0.0062857765 0.0007032762 0.002162630
## [26,] 0.095993829 0.07691441 -0.0333876851 -0.1163091680 0.024840002
## [27,] -0.093218599 0.09721678 0.0154293952 0.2645209386 -0.048816222
## [28,] -0.007152153 -0.04130734 0.0404046167 -0.0948009272 0.055645146
## [29,] -0.147832868 -0.04427752 0.0928295712 0.0270343909 -0.403064440
## [30,] -0.132877643 -0.11344903 0.0276893684 -0.0561918780 -0.103129656
## [31,] -0.022112363 -0.02829781 0.0683882235 0.1540437887 -0.025262163
## [,16] [,17] [,18] [,19] [,20]
## [1,] -0.13332729 0.02238740 0.36705960 0.359280723 -0.012628789
## [2,] -0.30581871 -0.05367331 -0.15941763 -0.012438818 -0.074844511
## [3,] 0.01033680 0.30294428 0.23456383 -0.117895773 -0.433554248
## [4,] 0.02552537 0.21403718 -0.11074334 0.113495129 0.145408290
## [5,] 0.13202432 -0.03604960 -0.25965510 -0.004012680 0.225266688
## [6,] -0.31515781 -0.33833157 -0.02453322 0.066349202 -0.042571325
## [7,] 0.25586621 -0.09706911 0.09182119 -0.067422852 0.053820913
## [8,] 0.04507113 0.25114309 -0.08411690 -0.159185560 -0.085591406
## [9,] -0.16214830 0.04998756 -0.03319049 0.425172218 -0.303386524
## [10,] -0.01316686 0.29459260 0.10539250 -0.101379452 0.326697094
## [11,] -0.31812427 0.16738436 -0.08277688 -0.088299706 0.374043703
## [12,] 0.22766603 0.19349034 0.23806683 -0.195122578 -0.150445627
## [13,] -0.12382624 -0.05554689 0.17017277 -0.022387620 0.093599606
## [14,] -0.06929680 0.16757274 0.04671959 0.045762448 -0.042619427
## [15,] -0.22283106 0.23453927 -0.09979670 -0.077029344 -0.113863102
## [16,] -0.19797445 0.28378782 0.11735614 -0.289340926 -0.055649925
## [17,] -0.04859245 -0.09112638 -0.18189376 0.115329474 -0.049234046
## [18,] -0.07704527 -0.12657815 -0.21035534 -0.102017155 -0.025033042
## [19,] 0.20668548 -0.21649737 0.29324516 -0.106278134 -0.051056115
## [20,] -0.08841258 0.14300653 -0.20486181 -0.098659451 -0.183650428
## [21,] 0.07752981 -0.15109764 0.11581458 -0.013400674 -0.145507134
## [22,] 0.11654955 0.07920436 0.05889314 0.425908466 0.173662571
## [23,] 0.16353611 0.28813755 -0.28849202 0.151013954 0.100979785
## [24,] 0.16120700 0.05414432 0.07103796 0.337563663 -0.015862755
## [25,] 0.24998951 0.25936464 -0.28297922 0.200084756 -0.294918157
## [26,] -0.11472115 0.10702473 0.16775004 0.088206526 -0.003137721
## [27,] 0.04187125 -0.11776208 -0.11723584 0.005256434 -0.202487702
## [28,] 0.18426347 -0.04307199 -0.05837401 0.093008078 0.011239622
## [29,] 0.06985502 0.10667284 -0.04912891 0.092185747 0.235721946
## [30,] 0.40487225 -0.10679677 -0.11594470 -0.215202251 0.050910088
## [31,] 0.06229945 0.15930822 0.32672933 0.078358800 0.216690464
## [,21] [,22] [,23] [,24] [,25]
## [1,] -0.151371682 -0.37395175 0.229317269 0.236718875 0.09880064
## [2,] -0.083231888 -0.17833699 0.044698576 -0.228108132 -0.20108635
## [3,] 0.246329606 -0.08514071 0.034538009 0.061701005 0.24552528
## [4,] 0.214742199 0.20183337 0.017427763 0.252522839 -0.10710597
## [5,] 0.031481223 -0.32094978 -0.436637700 0.202709447 -0.04505929
## [6,] -0.035942514 -0.11806594 0.124341350 -0.283092827 -0.09625428
## [7,] -0.057360325 -0.11661593 0.083166440 -0.217979533 -0.25236568
## [8,] -0.152860254 0.08907767 0.335921423 0.169270530 -0.02655020
## [9,] -0.022558217 -0.12682844 0.022337676 -0.140679158 -0.14979798
## [10,] 0.011366164 -0.31467680 0.032600421 0.029421533 -0.38647850
## [11,] -0.059025698 0.07550383 0.146584435 -0.002282807 0.06867393
## [12,] -0.182198018 0.08260506 -0.157908849 -0.102162224 0.01453901
## [13,] -0.146854489 0.01812272 0.057148722 0.155730767 0.15518456
## [14,] 0.153576231 0.05737152 0.160959788 -0.085622918 -0.32440844
## [15,] -0.054464899 -0.37556193 -0.046844336 -0.033851928 0.20084082
## [16,] 0.001769218 -0.04585223 -0.382649955 -0.194738124 -0.13007118
## [17,] -0.093807939 0.24151853 0.038683753 -0.056264323 -0.14567251
## [18,] 0.073594129 0.02455367 -0.049954843 0.019317920 0.29228177
## [19,] 0.224639381 0.03691825 -0.100695008 -0.224959124 -0.21881804
## [20,] -0.133430361 0.17810305 0.086553320 -0.133307572 -0.10650499
## [21,] -0.046253050 0.03165545 0.092543612 0.092655742 -0.07095852
## [22,] -0.004734249 0.16864216 -0.148149321 -0.070790905 -0.06330624
## [23,] 0.011791888 -0.08797651 -0.007701363 -0.499308284 0.26107014
## [24,] 0.291672079 -0.08093967 -0.097759826 -0.192846730 0.24337723
## [25,] -0.144208675 0.03494707 0.081620008 0.160613045 -0.24300516
## [26,] -0.033083900 -0.05144611 -0.108754672 -0.066657008 -0.15084335
## [27,] 0.031816644 -0.25282299 -0.244495413 0.279353585 -0.20397369
## [28,] -0.605367824 -0.06823558 -0.187495553 0.014044921 0.07782985
## [29,] 0.295507887 -0.07361037 0.171865856 0.081420348 -0.04667017
## [30,] -0.019538357 -0.37221944 0.432911538 -0.143243070 0.04383296
## [31,] -0.319455353 0.12380232 0.012188584 -0.132552980 0.05634309
## [,26] [,27] [,28] [,29] [,30]
## [1,] -0.121793897 -0.145491473 0.021191456 0.039405383 -0.07811788
## [2,] -0.130865200 -0.047643343 0.042668406 -0.348455561 0.12202425
## [3,] -0.091060628 -0.189481653 -0.140811692 -0.082391182 -0.11487824
## [4,] 0.445213679 -0.138304301 0.119209841 -0.087773524 0.03667258
## [5,] -0.085359932 -0.325956475 0.073455550 -0.157553239 -0.08709152
## [6,] 0.085664305 -0.317609899 -0.153198707 -0.018891491 0.26866383
## [7,] 0.204722119 0.169543956 -0.096768329 0.193523838 -0.25318717
## [8,] 0.133168503 0.104083032 -0.177954261 -0.224957043 0.41843598
## [9,] 0.038434878 0.248940180 0.272677254 0.116244574 -0.12899265
## [10,] 0.090077703 0.116726061 -0.001491107 0.082929194 -0.01028600
## [11,] -0.313256906 -0.030954523 -0.069904444 0.315768771 -0.03122786
## [12,] -0.237134458 -0.007496929 0.343290056 0.068238047 0.31983729
## [13,] 0.135333851 -0.364496385 0.251069089 0.009669433 0.10577334
## [14,] 0.187157359 -0.384816655 0.138525187 -0.030791922 -0.18675618
## [15,] 0.283155278 0.367778584 -0.046675554 -0.158733243 -0.00538172
## [16,] 0.206586923 -0.112183184 -0.027394706 0.190165436 0.02366650
## [17,] 0.098151957 0.135046775 0.256346342 -0.116166165 0.04606001
## [18,] 0.014167942 0.050888226 -0.084404980 0.065503210 -0.38199923
## [19,] -0.128524166 0.010898062 -0.071830865 -0.338798783 -0.07076227
## [20,] -0.104067267 -0.229603541 -0.343112368 -0.022077887 -0.10849173
## [21,] 0.273742236 -0.086024282 -0.395308817 0.313121578 -0.02976894
## [22,] -0.079650786 0.057695136 -0.234570341 0.190802988 0.27173389
## [23,] -0.031576851 -0.143867322 -0.035291600 0.105877815 0.07671391
## [24,] 0.221096064 -0.098418934 -0.061791887 -0.042286573 0.19443801
## [25,] -0.230253846 -0.129067993 0.029791142 0.048125478 -0.18706415
## [26,] -0.205831762 -0.012213837 -0.106506931 -0.019316552 -0.07170758
## [27,] -0.084717342 0.056293611 -0.237150624 0.170415139 0.33531227
## [28,] 0.202151516 -0.116422019 -0.154753356 -0.235304182 -0.11455825
## [29,] -0.185883369 0.086349190 -0.247705422 -0.348176441 -0.01186987
## [30,] 0.002385878 -0.107593926 0.164336976 0.135397114 0.07367353
## [31,] 0.028013920 0.045721467 -0.136696356 -0.234467393 -0.15600115
## [,31]
## [1,] 0.059192962
## [2,] 0.070743190
## [3,] 0.013813275
## [4,] 0.035532603
## [5,] 0.059170579
## [6,] 0.072757324
## [7,] -0.140221737
## [8,] -0.083273527
## [9,] 0.019147427
## [10,] 0.031119458
## [11,] -0.020583924
## [12,] -0.055708754
## [13,] -0.081793971
## [14,] 0.060281500
## [15,] 0.103987138
## [16,] -0.004291647
## [17,] -0.139302598
## [18,] 0.062845358
## [19,] 0.156622351
## [20,] 0.046982587
## [21,] -0.076130868
## [22,] 0.195914581
## [23,] 0.001536747
## [24,] -0.165862319
## [25,] 0.116537740
## [26,] -0.668753137
## [27,] 0.162559932
## [28,] -0.257998696
## [29,] -0.225913566
## [30,] 0.028088340
## [31,] 0.448573540pca2<-princomp(pd, cor=T)
pca2## Call:
## princomp(x = pd, cor = T)
##
## Standard deviations:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8
## 1.3949595 1.2866814 1.2811129 1.2061402 1.1852728 1.1596146 1.1355100 1.1088235
## Comp.9 Comp.10 Comp.11 Comp.12 Comp.13 Comp.14 Comp.15 Comp.16
## 1.0761943 1.0668773 1.0578421 1.0402622 1.0306744 1.0259684 0.9942238 0.9738563
## Comp.17 Comp.18 Comp.19 Comp.20 Comp.21 Comp.22 Comp.23 Comp.24
## 0.9668886 0.9268774 0.9237637 0.8985372 0.8892441 0.8700520 0.8643382 0.8479418
## Comp.25 Comp.26 Comp.27 Comp.28 Comp.29 Comp.30 Comp.31
## 0.8223253 0.8070374 0.7854670 0.7750552 0.7662432 0.6880688 0.6406326
##
## 31 variables and 1128 observations.loadings(pca2)##
## Loadings:
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7
## L_caudate_ComputeArea 0.125 0.172 0.208 0.270 0.119
## L_caudate_Volume 0.160 -0.123 0.349 0.273
## R_caudate_ComputeArea 0.120 -0.126 0.245 -0.375 0.199
## R_caudate_Volume -0.178 0.128 0.187 -0.441
## L_putamen_ComputeArea -0.112 0.214 0.383 -0.181
## L_putamen_Volume -0.133 -0.436 0.155 -0.208
## R_putamen_ComputeArea 0.163 0.197 -0.172 0.145 -0.208
## R_putamen_Volume -0.184 0.434 0.102 0.164
## L_hippocampus_ComputeArea 0.279 -0.179 -0.283 -0.103
## L_hippocampus_Volume -0.169 -0.272 0.187 0.273
## R_hippocampus_ComputeArea 0.165 -0.205 -0.447
## R_hippocampus_Volume 0.234 -0.261 -0.281 -0.152
## cerebellum_ComputeArea -0.177 0.120 0.119 -0.130
## cerebellum_Volume -0.368 -0.128 -0.234
## L_lingual_gyrus_ComputeArea -0.369 0.134 -0.370
## L_lingual_gyrus_Volume 0.159 0.103 0.282 0.151 0.174 0.122
## R_lingual_gyrus_ComputeArea 0.103 0.183 0.107 0.105
## R_lingual_gyrus_Volume -0.111 -0.162 0.122 0.194 0.186
## L_fusiform_gyrus_ComputeArea 0.192 0.168 0.222 -0.472
## L_fusiform_gyrus_Volume 0.207 -0.206 0.107
## R_fusiform_gyrus_ComputeArea 0.168 0.216 -0.394
## R_fusiform_gyrus_Volume 0.103 -0.173 0.227 0.408
## Sex 0.325 -0.207
## Weight -0.154 0.150 -0.157 0.345 -0.104
## Age -0.200 0.142 -0.160 0.223 0.258
## Dx -0.529 -0.171 0.119 -0.150
## chr12_rs34637584_GT -0.180 -0.426 -0.112 -0.138 -0.144
## chr17_rs11868035_GT 0.329 -0.308 0.111
## UPDRS_part_I 0.315 -0.129 -0.245 0.111
## UPDRS_part_II -0.194 -0.175 0.312 -0.115
## UPDRS_part_III -0.423 -0.225 -0.167 0.118
## Comp.8 Comp.9 Comp.10 Comp.11 Comp.12 Comp.13
## L_caudate_ComputeArea 0.167 0.351 0.101 0.129
## L_caudate_Volume -0.126
## R_caudate_ComputeArea -0.211 -0.117
## R_caudate_Volume 0.162 0.402
## L_putamen_ComputeArea -0.127 -0.300
## L_putamen_Volume 0.169 0.132
## R_putamen_ComputeArea -0.239 0.348 -0.213 0.178
## R_putamen_Volume -0.146 0.117 0.129 -0.157 -0.126 0.137
## L_hippocampus_ComputeArea -0.291 -0.362
## L_hippocampus_Volume 0.188 -0.473
## R_hippocampus_ComputeArea 0.162 -0.160 0.276 -0.131
## R_hippocampus_Volume 0.251 0.202
## cerebellum_ComputeArea -0.493 -0.281 -0.377
## cerebellum_Volume 0.229 -0.384 0.311
## L_lingual_gyrus_ComputeArea -0.170 -0.118 0.200 -0.110
## L_lingual_gyrus_Volume -0.262 0.214 -0.140 0.282
## R_lingual_gyrus_ComputeArea 0.214 0.134 0.265 0.202 -0.398 -0.243
## R_lingual_gyrus_Volume 0.283 0.437 -0.253 -0.136 -0.137
## L_fusiform_gyrus_ComputeArea 0.133 0.107 -0.298
## L_fusiform_gyrus_Volume 0.240 0.187 -0.294 -0.434 -0.276
## R_fusiform_gyrus_ComputeArea -0.226 -0.178 0.125 0.302 -0.180 -0.269
## R_fusiform_gyrus_Volume -0.184 -0.268 -0.104 -0.301
## Sex -0.154 0.214 0.277 0.251 -0.139
## Weight 0.262 0.287 -0.230 -0.106
## Age -0.183 -0.207 0.281 0.188 0.185
## Dx
## chr12_rs34637584_GT 0.101 0.159 0.211
## chr17_rs11868035_GT 0.245 -0.139
## UPDRS_part_I -0.236 -0.154 0.188 -0.148
## UPDRS_part_II 0.171 -0.289 -0.133 -0.113
## UPDRS_part_III -0.121 0.204
## Comp.14 Comp.15 Comp.16 Comp.17 Comp.18 Comp.19
## L_caudate_ComputeArea 0.157 0.133 0.367 0.359
## L_caudate_Volume -0.133 -0.542 0.306 -0.159
## R_caudate_ComputeArea -0.258 0.303 0.235 -0.118
## R_caudate_Volume 0.125 0.214 -0.111 0.113
## L_putamen_ComputeArea -0.132 -0.260
## L_putamen_Volume 0.203 0.259 0.315 -0.338
## R_putamen_ComputeArea -0.366 -0.256
## R_putamen_Volume 0.166 -0.128 0.251 -0.159
## L_hippocampus_ComputeArea 0.165 0.162 0.425
## L_hippocampus_Volume 0.118 0.295 0.105 -0.101
## R_hippocampus_ComputeArea -0.121 -0.202 0.318 0.167
## R_hippocampus_Volume 0.266 -0.228 0.193 0.238 -0.195
## cerebellum_ComputeArea -0.271 0.124 0.170
## cerebellum_Volume 0.106 0.168
## L_lingual_gyrus_ComputeArea 0.150 0.223 0.235
## L_lingual_gyrus_Volume 0.278 0.198 0.284 0.117 -0.289
## R_lingual_gyrus_ComputeArea -0.388 0.320 -0.182 0.115
## R_lingual_gyrus_Volume 0.386 -0.127 -0.210 -0.102
## L_fusiform_gyrus_ComputeArea 0.142 -0.207 -0.216 0.293 -0.106
## L_fusiform_gyrus_Volume 0.199 0.143 -0.205
## R_fusiform_gyrus_ComputeArea -0.134 -0.151 0.116
## R_fusiform_gyrus_Volume 0.121 -0.117 0.426
## Sex -0.164 0.288 -0.288 0.151
## Weight -0.119 -0.277 -0.161 0.338
## Age -0.250 0.259 -0.283 0.200
## Dx 0.116 0.115 0.107 0.168
## chr12_rs34637584_GT -0.265 -0.118 -0.117
## chr17_rs11868035_GT -0.184
## UPDRS_part_I 0.403 0.107
## UPDRS_part_II 0.103 -0.405 -0.107 -0.116 -0.215
## UPDRS_part_III -0.154 0.159 0.327
## Comp.20 Comp.21 Comp.22 Comp.23 Comp.24 Comp.25
## L_caudate_ComputeArea 0.151 0.374 0.229 0.237
## L_caudate_Volume 0.178 -0.228 -0.201
## R_caudate_ComputeArea 0.434 -0.246 0.246
## R_caudate_Volume -0.145 -0.215 -0.202 0.253 -0.107
## L_putamen_ComputeArea -0.225 0.321 -0.437 0.203
## L_putamen_Volume 0.118 0.124 -0.283
## R_putamen_ComputeArea 0.117 -0.218 -0.252
## R_putamen_Volume 0.153 0.336 0.169
## L_hippocampus_ComputeArea 0.303 0.127 -0.141 -0.150
## L_hippocampus_Volume -0.327 0.315 -0.386
## R_hippocampus_ComputeArea -0.374 0.147
## R_hippocampus_Volume 0.150 0.182 -0.158 -0.102
## cerebellum_ComputeArea 0.147 0.156 0.155
## cerebellum_Volume -0.154 0.161 -0.324
## L_lingual_gyrus_ComputeArea 0.114 0.376 0.201
## L_lingual_gyrus_Volume -0.383 -0.195 -0.130
## R_lingual_gyrus_ComputeArea -0.242 -0.146
## R_lingual_gyrus_Volume 0.292
## L_fusiform_gyrus_ComputeArea -0.225 -0.101 -0.225 -0.219
## L_fusiform_gyrus_Volume 0.184 0.133 -0.178 -0.133 -0.107
## R_fusiform_gyrus_ComputeArea 0.146
## R_fusiform_gyrus_Volume -0.174 -0.169 -0.148
## Sex -0.101 -0.499 0.261
## Weight -0.292 -0.193 0.243
## Age 0.295 0.144 0.161 -0.243
## Dx -0.109 -0.151
## chr12_rs34637584_GT 0.202 0.253 -0.244 0.279 -0.204
## chr17_rs11868035_GT 0.605 -0.187
## UPDRS_part_I -0.236 -0.296 0.172
## UPDRS_part_II 0.372 0.433 -0.143
## UPDRS_part_III -0.217 0.319 -0.124 -0.133
## Comp.26 Comp.27 Comp.28 Comp.29 Comp.30 Comp.31
## L_caudate_ComputeArea 0.122 0.145
## L_caudate_Volume 0.131 -0.348 -0.122
## R_caudate_ComputeArea 0.189 -0.141 0.115
## R_caudate_Volume -0.445 0.138 0.119
## L_putamen_ComputeArea 0.326 -0.158
## L_putamen_Volume 0.318 -0.153 -0.269
## R_putamen_ComputeArea -0.205 -0.170 0.194 0.253 -0.140
## R_putamen_Volume -0.133 -0.104 -0.178 -0.225 -0.418
## L_hippocampus_ComputeArea -0.249 0.273 0.116 0.129
## L_hippocampus_Volume -0.117
## R_hippocampus_ComputeArea 0.313 0.316
## R_hippocampus_Volume 0.237 0.343 -0.320
## cerebellum_ComputeArea -0.135 0.364 0.251 -0.106
## cerebellum_Volume -0.187 0.385 0.139 0.187
## L_lingual_gyrus_ComputeArea -0.283 -0.368 -0.159 0.104
## L_lingual_gyrus_Volume -0.207 0.112 0.190
## R_lingual_gyrus_ComputeArea -0.135 0.256 -0.116 -0.139
## R_lingual_gyrus_Volume 0.382
## L_fusiform_gyrus_ComputeArea 0.129 -0.339 0.157
## L_fusiform_gyrus_Volume 0.104 0.230 -0.343 0.108
## R_fusiform_gyrus_ComputeArea -0.274 -0.395 0.313
## R_fusiform_gyrus_Volume -0.235 0.191 -0.272 0.196
## Sex 0.144 0.106
## Weight -0.221 -0.194 -0.166
## Age 0.230 0.129 0.187 0.117
## Dx 0.206 -0.107 -0.669
## chr12_rs34637584_GT -0.237 0.170 -0.335 0.163
## chr17_rs11868035_GT -0.202 0.116 -0.155 -0.235 0.115 -0.258
## UPDRS_part_I 0.186 -0.248 -0.348 -0.226
## UPDRS_part_II 0.108 0.164 0.135
## UPDRS_part_III -0.137 -0.234 0.156 0.449
##
## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8 Comp.9
## SS loadings 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000
## Proportion Var 0.032 0.032 0.032 0.032 0.032 0.032 0.032 0.032 0.032
## Cumulative Var 0.032 0.065 0.097 0.129 0.161 0.194 0.226 0.258 0.290
## Comp.10 Comp.11 Comp.12 Comp.13 Comp.14 Comp.15 Comp.16 Comp.17
## SS loadings 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000
## Proportion Var 0.032 0.032 0.032 0.032 0.032 0.032 0.032 0.032
## Cumulative Var 0.323 0.355 0.387 0.419 0.452 0.484 0.516 0.548
## Comp.18 Comp.19 Comp.20 Comp.21 Comp.22 Comp.23 Comp.24 Comp.25
## SS loadings 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000
## Proportion Var 0.032 0.032 0.032 0.032 0.032 0.032 0.032 0.032
## Cumulative Var 0.581 0.613 0.645 0.677 0.710 0.742 0.774 0.806
## Comp.26 Comp.27 Comp.28 Comp.29 Comp.30 Comp.31
## SS loadings 1.000 1.000 1.000 1.000 1.000 1.000
## Proportion Var 0.032 0.032 0.032 0.032 0.032 0.032
## Cumulative Var 0.839 0.871 0.903 0.935 0.968 1.000##The proportion variance are decomposed into single value of equal split between variables that summed up to 100%. The SS loadings is equal to 1 as a result of equal SD. The Loadings generated are based on the assumed equal variance. The high value of loadings is well explained by the components (between -1 to 1).S <- matrix(runif(10000), 5000, 2)
A <- matrix(c(1, 1, -1, 3), 2, 2, byrow = TRUE)
X <- S %*% A
cor(X)## [,1] [,2]
## [1,] 1.0000000 -0.4442635
## [2,] -0.4442635 1.0000000## The correlation between two variables is -0.4.
library(fastICA)
a <- fastICA(pd, 2, alg.typ = "parallel", fun = "logcosh", alpha = 1,
method = "C", row.norm = FALSE, maxit = 200, tol = 0.0001)
plot_ly() %>%
add_markers(x = a$X[ , 1], y =~a$X[ , 2], name="Pre-processed data",
marker = list(color="green", opacity=0.9, symbol=105)) %>%
add_markers(x = a$S[ , 1], y = a$S[ , 2], name="ICA components",
marker = list(color="blue", opacity=0.99, symbol=5)) %>%
layout(title='Scatter Plots of the Original (Pre-processed) Data and the corresponding ICA Transform',
xaxis = list(title="Twin 1 (standardized height)"),
yaxis = list(title="Twin 2 (standardized height)"),
legend = list(orientation = 'h'))#ICA Component is more concentric than the scattered pre-processed data, indicating higher precision and accurracy in the origin.
cor(a$X)## [,1] [,2] [,3] [,4] [,5]
## [1,] 1.000000000 0.057949162 -0.0605763607 0.0439944567 0.009640983
## [2,] 0.057949162 1.000000000 0.0107637202 0.0724556772 -0.066328127
## [3,] -0.060576361 0.010763720 1.0000000000 0.0574418888 -0.015959528
## [4,] 0.043994457 0.072455677 0.0574418888 1.0000000000 -0.017003442
## [5,] 0.009640983 -0.066328127 -0.0159595277 -0.0170034418 1.000000000
## [6,] -0.064299184 -0.111315248 0.0632793506 0.0219626908 0.022289469
## [7,] 0.040808105 0.045048667 0.0786434793 0.0542874668 0.090496109
## [8,] 0.058552841 -0.118303868 0.0070228441 -0.0943363762 0.176353726
## [9,] -0.037932760 -0.044436146 0.0513596126 0.0061233548 0.094604791
## [10,] -0.042033469 -0.046808250 0.0857883277 -0.0779136142 -0.064425367
## [11,] -0.002783361 0.025203214 0.0485229366 0.1004441878 0.022846806
## [12,] 0.024725742 0.036380498 0.0211805872 0.1033424738 0.002255100
## [13,] -0.094952000 0.013148246 -0.0211309613 -0.0927916850 -0.080519787
## [14,] -0.061229901 -0.040458242 -0.0451142729 -0.1187781231 -0.119516694
## [15,] -0.022587205 -0.006119229 -0.0462044972 0.0419035130 0.003899237
## [16,] 0.116048548 0.070234408 -0.0111429907 -0.0196789750 -0.014868374
## [17,] 0.098853870 0.001729507 0.0715683013 -0.0189183712 0.061570896
## [18,] -0.011790657 0.069257523 -0.0393249154 0.0243463607 -0.061610619
## [19,] 0.076380247 -0.090679761 -0.0326753390 0.0224746511 -0.010221932
## [20,] 0.046459905 -0.011737155 -0.0916756764 0.0482441380 0.038593824
## [21,] 0.036679106 0.130777186 -0.0585847019 -0.0034107044 0.104620649
## [22,] 0.021681734 0.077228439 0.0873506384 0.0477616761 -0.015490109
## [23,] 0.038599173 -0.029475777 -0.0008057058 0.0003693636 0.002385885
## [24,] 0.006390781 -0.024066767 -0.0888347415 -0.0618969459 0.012788207
## [25,] -0.057579260 -0.018770009 -0.0421641960 -0.0038565579 -0.044711273
## [26,] -0.062310805 -0.041388158 -0.0528791702 0.0872425964 0.044774224
## [27,] -0.074422650 -0.039020904 -0.0015185912 0.0156824348 -0.120278347
## [28,] -0.009806497 0.011846711 0.0799225687 0.0095353912 -0.156409607
## [29,] -0.007884304 0.045224549 -0.0018960500 0.0190613314 -0.072932152
## [30,] -0.056367890 0.014983177 -0.0069141588 0.0774268220 -0.002169260
## [31,] -0.108282780 -0.077673894 -0.0432303893 0.0132678735 0.044680726
## [,6] [,7] [,8] [,9] [,10]
## [1,] -0.064299184 0.0408081047 0.0585528411 -0.037932760 -0.042033469
## [2,] -0.111315248 0.0450486670 -0.1183038681 -0.044436146 -0.046808250
## [3,] 0.063279351 0.0786434793 0.0070228441 0.051359613 0.085788328
## [4,] 0.021962691 0.0542874668 -0.0943363762 0.006123355 -0.077913614
## [5,] 0.022289469 0.0904961089 0.1763537262 0.094604791 -0.064425367
## [6,] 1.000000000 0.0909392560 -0.0576876476 0.025303302 0.040415566
## [7,] 0.090939256 1.0000000000 0.0522452643 -0.055084723 -0.088663440
## [8,] -0.057687648 0.0522452643 1.0000000000 0.131800075 -0.001133570
## [9,] 0.025303302 -0.0550847226 0.1318000754 1.000000000 -0.026338163
## [10,] 0.040415566 -0.0886634398 -0.0011335705 -0.026338163 1.000000000
## [11,] 0.029817182 0.0378953276 0.0158998200 0.055162016 -0.055332655
## [12,] 0.031507593 0.1240234965 -0.1405112929 -0.030065154 -0.002067794
## [13,] -0.049719667 0.0517207587 -0.0073688116 0.036032569 0.029312082
## [14,] -0.081872936 -0.0833397951 0.0110699290 -0.026242693 -0.021396812
## [15,] 0.046427275 0.0178577171 -0.1177935564 -0.112656173 -0.082089050
## [16,] -0.086196846 -0.0499646315 0.0786790785 0.002752942 -0.054125472
## [17,] -0.004577468 -0.0173173654 0.0002952288 -0.070077989 0.002641454
## [18,] 0.060976863 -0.0415054215 0.1041121238 -0.032147097 0.055886331
## [19,] -0.060191221 0.0015593749 0.0862434234 0.035623110 -0.042690471
## [20,] -0.069277282 -0.0004978113 -0.0352538013 0.028728440 0.004536290
## [21,] -0.086435977 -0.0862187955 -0.0355634205 0.055341451 -0.061342832
## [22,] -0.052259027 0.0674214741 -0.0652563727 -0.043754370 -0.032586060
## [23,] -0.110828126 -0.0274272757 0.0973109582 0.061805559 0.042336466
## [24,] -0.023769502 0.0024134816 -0.0464116174 -0.030826359 0.049807652
## [25,] 0.084860679 0.0278577339 0.0170643410 -0.112966971 0.007116462
## [26,] 0.036956288 -0.1358343053 0.0438173405 -0.027539695 -0.051600056
## [27,] -0.083706932 -0.0290481249 -0.0772912568 0.035118713 -0.028965313
## [28,] -0.004923399 -0.0271350333 -0.1006941854 0.046063832 0.063798456
## [29,] -0.001483827 0.0340820176 -0.1563259364 0.065709989 -0.010349551
## [30,] -0.075792511 -0.0758263997 -0.0403658339 -0.029103688 -0.076428306
## [31,] 0.015850363 -0.0463011268 0.0518657126 0.033468915 -0.027865092
## [,11] [,12] [,13] [,14] [,15]
## [1,] -0.002783361 0.024725742 -0.0949519999 -6.122990e-02 -0.022587205
## [2,] 0.025203214 0.036380498 0.0131482460 -4.045824e-02 -0.006119229
## [3,] 0.048522937 0.021180587 -0.0211309613 -4.511427e-02 -0.046204497
## [4,] 0.100444188 0.103342474 -0.0927916850 -1.187781e-01 0.041903513
## [5,] 0.022846806 0.002255100 -0.0805197869 -1.195167e-01 0.003899237
## [6,] 0.029817182 0.031507593 -0.0497196673 -8.187294e-02 0.046427275
## [7,] 0.037895328 0.124023497 0.0517207587 -8.333980e-02 0.017857717
## [8,] 0.015899820 -0.140511293 -0.0073688116 1.106993e-02 -0.117793556
## [9,] 0.055162016 -0.030065154 0.0360325687 -2.624269e-02 -0.112656173
## [10,] -0.055332655 -0.002067794 0.0293120816 -2.139681e-02 -0.082089050
## [11,] 1.000000000 0.038448935 -0.0143904209 2.032270e-02 0.102370486
## [12,] 0.038448935 1.000000000 -0.0752726871 4.000690e-02 0.104973127
## [13,] -0.014390421 -0.075272687 1.0000000000 6.668298e-04 0.072692406
## [14,] 0.020322704 0.040006898 0.0006668298 1.000000e+00 0.083014650
## [15,] 0.102370486 0.104973127 0.0726924064 8.301465e-02 1.000000000
## [16,] 0.009498144 -0.069293108 -0.0155316206 -7.902774e-02 -0.050061810
## [17,] 0.040292861 -0.057626399 -0.0459445725 -3.840406e-02 -0.012521019
## [18,] -0.058547497 0.071133697 0.0710730116 3.997070e-02 -0.046263840
## [19,] 0.126587671 -0.038315661 0.0710622522 -3.616849e-02 0.012028231
## [20,] -0.021437521 0.089799963 -0.0008680112 -6.490658e-02 0.081254470
## [21,] -0.005447456 0.125532417 -0.0166462028 -3.841863e-02 0.018667751
## [22,] -0.031054348 -0.012531124 0.0701916418 3.562701e-02 0.077002373
## [23,] -0.055625242 -0.070721253 0.0132265749 4.504427e-02 -0.086942547
## [24,] 0.044625981 0.011612721 -0.0426038997 -1.630739e-05 0.024766893
## [25,] -0.009230832 0.017065775 0.0536984565 -8.917659e-02 0.119556569
## [26,] -0.096544892 -0.111932634 0.0239674138 3.846083e-02 0.110281769
## [27,] -0.005279368 -0.055264338 0.0805322917 1.758967e-01 -0.031596541
## [28,] 0.117144032 0.067156177 -0.0334544498 6.491980e-02 -0.048783666
## [29,] 0.031223594 0.164251246 0.0606837020 5.135736e-02 -0.001114899
## [30,] -0.033459803 -0.060181517 -0.0339674861 -2.159899e-02 0.028106839
## [31,] -0.048126622 0.003011558 0.0365981815 6.805303e-04 -0.045800485
## [,16] [,17] [,18] [,19] [,20]
## [1,] 0.116048548 0.0988538702 -0.011790657 0.076380247 0.0464599053
## [2,] 0.070234408 0.0017295072 0.069257523 -0.090679761 -0.0117371552
## [3,] -0.011142991 0.0715683013 -0.039324915 -0.032675339 -0.0916756764
## [4,] -0.019678975 -0.0189183712 0.024346361 0.022474651 0.0482441380
## [5,] -0.014868374 0.0615708961 -0.061610619 -0.010221932 0.0385938241
## [6,] -0.086196846 -0.0045774685 0.060976863 -0.060191221 -0.0692772822
## [7,] -0.049964631 -0.0173173654 -0.041505421 0.001559375 -0.0004978113
## [8,] 0.078679078 0.0002952288 0.104112124 0.086243423 -0.0352538013
## [9,] 0.002752942 -0.0700779893 -0.032147097 0.035623110 0.0287284396
## [10,] -0.054125472 0.0026414544 0.055886331 -0.042690471 0.0045362905
## [11,] 0.009498144 0.0402928608 -0.058547497 0.126587671 -0.0214375208
## [12,] -0.069293108 -0.0576263986 0.071133697 -0.038315661 0.0897999633
## [13,] -0.015531621 -0.0459445725 0.071073012 0.071062252 -0.0008680112
## [14,] -0.079027741 -0.0384040631 0.039970704 -0.036168485 -0.0649065820
## [15,] -0.050061810 -0.0125210194 -0.046263840 0.012028231 0.0812544697
## [16,] 1.000000000 0.0509647037 0.019211806 0.045497873 -0.0271557708
## [17,] 0.050964704 1.0000000000 0.057937097 0.027781613 0.0281547429
## [18,] 0.019211806 0.0579370966 1.000000000 0.002849041 -0.0594284858
## [19,] 0.045497873 0.0277816132 0.002849041 1.000000000 -0.0419533283
## [20,] -0.027155771 0.0281547429 -0.059428486 -0.041953328 1.0000000000
## [21,] -0.012286459 0.0589518717 -0.059788104 0.044736358 -0.0356402709
## [22,] 0.020049300 0.0408787868 0.091348377 0.017539820 -0.0311141108
## [23,] -0.018427691 0.0224820427 -0.003575238 0.059660339 -0.0779122794
## [24,] -0.021538698 0.0082294805 0.018825604 -0.005905942 0.0927378070
## [25,] 0.034561725 -0.0077653940 -0.009843693 -0.008069209 -0.0712590677
## [26,] -0.050257178 -0.0115265699 0.102701122 -0.001374853 -0.0024801683
## [27,] -0.081046002 0.0362491229 0.128364143 0.003902625 -0.0354607382
## [28,] -0.005438733 -0.0449570726 -0.019325627 0.061098602 -0.0772014715
## [29,] 0.070878990 -0.0439466640 -0.001836697 -0.077617526 -0.0323223866
## [30,] 0.039747655 0.0460091933 0.056811919 0.026697285 0.0353543566
## [31,] -0.032160412 0.0491850028 0.007747446 -0.153668138 -0.0309029704
## [,21] [,22] [,23] [,24] [,25]
## [1,] 0.036679106 0.02168173 0.0385991734 6.390781e-03 -0.057579260
## [2,] 0.130777186 0.07722844 -0.0294757775 -2.406677e-02 -0.018770009
## [3,] -0.058584702 0.08735064 -0.0008057058 -8.883474e-02 -0.042164196
## [4,] -0.003410704 0.04776168 0.0003693636 -6.189695e-02 -0.003856558
## [5,] 0.104620649 -0.01549011 0.0023858846 1.278821e-02 -0.044711273
## [6,] -0.086435977 -0.05225903 -0.1108281264 -2.376950e-02 0.084860679
## [7,] -0.086218795 0.06742147 -0.0274272757 2.413482e-03 0.027857734
## [8,] -0.035563421 -0.06525637 0.0973109582 -4.641162e-02 0.017064341
## [9,] 0.055341451 -0.04375437 0.0618055589 -3.082636e-02 -0.112966971
## [10,] -0.061342832 -0.03258606 0.0423364655 4.980765e-02 0.007116462
## [11,] -0.005447456 -0.03105435 -0.0556252424 4.462598e-02 -0.009230832
## [12,] 0.125532417 -0.01253112 -0.0707212525 1.161272e-02 0.017065775
## [13,] -0.016646203 0.07019164 0.0132265749 -4.260390e-02 0.053698457
## [14,] -0.038418634 0.03562701 0.0450442738 -1.630739e-05 -0.089176591
## [15,] 0.018667751 0.07700237 -0.0869425473 2.476689e-02 0.119556569
## [16,] -0.012286459 0.02004930 -0.0184276912 -2.153870e-02 0.034561725
## [17,] 0.058951872 0.04087879 0.0224820427 8.229481e-03 -0.007765394
## [18,] -0.059788104 0.09134838 -0.0035752377 1.882560e-02 -0.009843693
## [19,] 0.044736358 0.01753982 0.0596603395 -5.905942e-03 -0.008069209
## [20,] -0.035640271 -0.03111411 -0.0779122794 9.273781e-02 -0.071259068
## [21,] 1.000000000 -0.06566910 0.0359503750 -3.402150e-02 -0.020751470
## [22,] -0.065669098 1.00000000 -0.0844861092 -7.136376e-02 0.031113763
## [23,] 0.035950375 -0.08448611 1.0000000000 -1.482279e-01 -0.049225520
## [24,] -0.034021504 -0.07136376 -0.1482278922 1.000000e+00 0.139051429
## [25,] -0.020751470 0.03111376 -0.0492255204 1.390514e-01 1.000000000
## [26,] -0.072316378 0.05949243 -0.0076823112 -2.283086e-02 0.041081129
## [27,] -0.097210253 -0.13244108 0.0875523358 -1.186151e-02 -0.073714992
## [28,] -0.064601120 0.08586294 0.0139690198 -7.022452e-02 -0.026469199
## [29,] 0.085498846 0.03328976 0.0142079026 -5.409860e-02 0.003748049
## [30,] -0.006664240 0.08467534 -0.0921494710 8.788121e-03 -0.001809455
## [31,] 0.028158074 -0.11879391 -0.0023184447 9.465782e-02 -0.018128786
## [,26] [,27] [,28] [,29] [,30]
## [1,] -0.062310805 -0.074422650 -0.009806497 -0.007884304 -0.056367890
## [2,] -0.041388158 -0.039020904 0.011846711 0.045224549 0.014983177
## [3,] -0.052879170 -0.001518591 0.079922569 -0.001896050 -0.006914159
## [4,] 0.087242596 0.015682435 0.009535391 0.019061331 0.077426822
## [5,] 0.044774224 -0.120278347 -0.156409607 -0.072932152 -0.002169260
## [6,] 0.036956288 -0.083706932 -0.004923399 -0.001483827 -0.075792511
## [7,] -0.135834305 -0.029048125 -0.027135033 0.034082018 -0.075826400
## [8,] 0.043817340 -0.077291257 -0.100694185 -0.156325936 -0.040365834
## [9,] -0.027539695 0.035118713 0.046063832 0.065709989 -0.029103688
## [10,] -0.051600056 -0.028965313 0.063798456 -0.010349551 -0.076428306
## [11,] -0.096544892 -0.005279368 0.117144032 0.031223594 -0.033459803
## [12,] -0.111932634 -0.055264338 0.067156177 0.164251246 -0.060181517
## [13,] 0.023967414 0.080532292 -0.033454450 0.060683702 -0.033967486
## [14,] 0.038460831 0.175896713 0.064919804 0.051357364 -0.021598988
## [15,] 0.110281769 -0.031596541 -0.048783666 -0.001114899 0.028106839
## [16,] -0.050257178 -0.081046002 -0.005438733 0.070878990 0.039747655
## [17,] -0.011526570 0.036249123 -0.044957073 -0.043946664 0.046009193
## [18,] 0.102701122 0.128364143 -0.019325627 -0.001836697 0.056811919
## [19,] -0.001374853 0.003902625 0.061098602 -0.077617526 0.026697285
## [20,] -0.002480168 -0.035460738 -0.077201471 -0.032322387 0.035354357
## [21,] -0.072316378 -0.097210253 -0.064601120 0.085498846 -0.006664240
## [22,] 0.059492429 -0.132441076 0.085862945 0.033289765 0.084675335
## [23,] -0.007682311 0.087552336 0.013969020 0.014207903 -0.092149471
## [24,] -0.022830857 -0.011861506 -0.070224524 -0.054098596 0.008788121
## [25,] 0.041081129 -0.073714992 -0.026469199 0.003748049 -0.001809455
## [26,] 1.000000000 0.150179558 -0.268127902 -0.266045456 0.175006841
## [27,] 0.150179558 1.000000000 0.077832012 0.014525253 0.055016524
## [28,] -0.268127902 0.077832012 1.000000000 0.076309465 -0.003920116
## [29,] -0.266045456 0.014525253 0.076309465 1.000000000 -0.029226578
## [30,] 0.175006841 0.055016524 -0.003920116 -0.029226578 1.000000000
## [31,] 0.373648507 0.122095490 -0.148043173 -0.054405917 0.114950853
## [,31]
## [1,] -0.1082827796
## [2,] -0.0776738936
## [3,] -0.0432303893
## [4,] 0.0132678735
## [5,] 0.0446807264
## [6,] 0.0158503628
## [7,] -0.0463011268
## [8,] 0.0518657126
## [9,] 0.0334689147
## [10,] -0.0278650925
## [11,] -0.0481266218
## [12,] 0.0030115580
## [13,] 0.0365981815
## [14,] 0.0006805303
## [15,] -0.0458004850
## [16,] -0.0321604115
## [17,] 0.0491850028
## [18,] 0.0077474458
## [19,] -0.1536681376
## [20,] -0.0309029704
## [21,] 0.0281580741
## [22,] -0.1187939072
## [23,] -0.0023184447
## [24,] 0.0946578218
## [25,] -0.0181287863
## [26,] 0.3736485068
## [27,] 0.1220954903
## [28,] -0.1480431731
## [29,] -0.0544059172
## [30,] 0.1149508533
## [31,] 1.0000000000mean(cor(a$X))## [1] 0.0317158## The average value of correlation is 0.0317
cor(a$S)## [,1] [,2]
## [1,] 1.000000e+00 -6.334936e-16
## [2,] -6.334936e-16 1.000000e+00# Dimensions were reduced from 31 variables to 2 components. The correlation of two components is nearly 0.library(nFactors)## Loading required package: lattice##
## Attaching package: 'nFactors'## The following object is masked from 'package:lattice':
##
## parallelev <- eigen(cor(pd)) # get eigenvalues
ap <- parallel(subject=nrow(pd), var=ncol(pd), rep=100, cent=.05)
nS <- nScree(x=ev$values, aparallel=ap$eigen$qevpea)
summary(nS)## Report For a nScree Class
##
## Details: components
##
## Eigenvalues Prop Cumu Par.Analysis Pred.eig OC Acc.factor AF
## 1 2 0 0 1 2 (< OC) NA (< AF)
## 2 2 0 0 1 2 0
## 3 2 0 0 1 1 0
## 4 1 0 0 1 1 0
## 5 1 0 0 1 1 0
## 6 1 0 0 1 1 0
## 7 1 0 0 1 1 0
## 8 1 0 0 1 1 0
## 9 1 0 0 1 1 0
## 10 1 0 0 1 1 0
## 11 1 0 0 1 1 0
## 12 1 0 1 1 1 0
## 13 1 0 1 1 1 0
## 14 1 0 1 1 1 0
## 15 1 0 1 1 1 0
## 16 1 0 1 1 1 0
## 17 1 0 1 1 1 0
## 18 1 0 1 1 1 0
## 19 1 0 1 1 1 0
## 20 1 0 1 1 1 0
## 21 1 0 1 1 1 0
## 22 1 0 1 1 1 0
## 23 1 0 1 1 1 0
## 24 1 0 1 1 1 0
## 25 1 0 1 1 1 0
## 26 1 0 1 1 1 0
## 27 1 0 1 1 1 0
## 28 1 0 1 1 1 0
## 29 1 0 1 1 1 0
## 30 0 0 1 1 NA 0
## 31 0 0 1 1 NA NA
##
##
## Number of factors retained by index
##
## noc naf nparallel nkaiser
## 1 1 1 14 14plotnScree(nS) 
plot_ly() %>%
add_trace(y = nS$Analysis$Eigenvalues, type="scatter", name = 'Eigenvalues',
mode = 'lines+markers', marker = list(opacity=0.99, size=20, symbol=5)) %>%
add_trace(y = nS$Analysis$Par.Analysis, type="scatter",
name = 'Parallel Analysis (centiles of random eigenvalues)',
mode = 'lines+markers', marker = list(opacity=0.99, size=20, symbol=2)) %>%
# add_trace(y = nS$Analysis$OC, type="scatter",
# name = 'Critical Optimal Coordinates',
# mode = 'lines+markers', marker = list(opacity=0.99, size=20, symbol=3)) %>%
add_trace(y = nS$Analysis$Acc.factor, type="scatter",
name = 'Acceleration Factor',
mode = 'lines+markers', marker = list(opacity=0.99, size=20, symbol=15)) %>%
layout(title='Scree plot',
xaxis = list(title="Components"),
yaxis = list(title="Eigenvalues"),
legend = list(orientation = 'h')) ## Scree test suggest that we should use 14 factors.However, the PCA suggests around 18 factors to explain an acceptable 72% of the variation.
fit1<-factanal(pd, factors=14, rotation="varimax")
fit1##
## Call:
## factanal(x = pd, factors = 14, rotation = "varimax")
##
## Uniquenesses:
## L_caudate_ComputeArea L_caudate_Volume
## 0.897 0.864
## R_caudate_ComputeArea R_caudate_Volume
## 0.874 0.842
## L_putamen_ComputeArea L_putamen_Volume
## 0.819 0.693
## R_putamen_ComputeArea R_putamen_Volume
## 0.005 0.552
## L_hippocampus_ComputeArea L_hippocampus_Volume
## 0.827 0.912
## R_hippocampus_ComputeArea R_hippocampus_Volume
## 0.777 0.777
## cerebellum_ComputeArea cerebellum_Volume
## 0.198 0.337
## L_lingual_gyrus_ComputeArea L_lingual_gyrus_Volume
## 0.779 0.921
## R_lingual_gyrus_ComputeArea R_lingual_gyrus_Volume
## 0.005 0.005
## L_fusiform_gyrus_ComputeArea L_fusiform_gyrus_Volume
## 0.787 0.005
## R_fusiform_gyrus_ComputeArea R_fusiform_gyrus_Volume
## 0.726 0.608
## Sex Weight
## 0.836 0.757
## Age Dx
## 0.872 0.162
## chr12_rs34637584_GT chr17_rs11868035_GT
## 0.641 0.744
## UPDRS_part_I UPDRS_part_II
## 0.804 0.872
## UPDRS_part_III
## 0.545
##
## Loadings:
## Factor1 Factor2 Factor3 Factor4 Factor5 Factor6
## L_caudate_ComputeArea
## L_caudate_Volume
## R_caudate_ComputeArea -0.135
## R_caudate_Volume -0.126
## L_putamen_ComputeArea
## L_putamen_Volume
## R_putamen_ComputeArea 0.979
## R_putamen_Volume 0.141
## L_hippocampus_ComputeArea -0.125
## L_hippocampus_Volume -0.101
## R_hippocampus_ComputeArea -0.120
## R_hippocampus_Volume
## cerebellum_ComputeArea 0.889
## cerebellum_Volume
## L_lingual_gyrus_ComputeArea 0.205
## L_lingual_gyrus_Volume
## R_lingual_gyrus_ComputeArea 0.992
## R_lingual_gyrus_Volume 0.990
## L_fusiform_gyrus_ComputeArea
## L_fusiform_gyrus_Volume 0.992
## R_fusiform_gyrus_ComputeArea -0.105
## R_fusiform_gyrus_Volume
## Sex
## Weight
## Age
## Dx 0.801
## chr12_rs34637584_GT 0.127
## chr17_rs11868035_GT -0.358
## UPDRS_part_I -0.282
## UPDRS_part_II 0.106
## UPDRS_part_III 0.211
## Factor7 Factor8 Factor9 Factor10 Factor11 Factor12
## L_caudate_ComputeArea -0.184
## L_caudate_Volume -0.106 0.234 0.113
## R_caudate_ComputeArea 0.138 0.193
## R_caudate_Volume -0.102 -0.185 0.147 0.111
## L_putamen_ComputeArea 0.390
## L_putamen_Volume -0.112 -0.108
## R_putamen_ComputeArea
## R_putamen_Volume 0.522 -0.318 0.136
## L_hippocampus_ComputeArea 0.190 0.143 0.249
## L_hippocampus_Volume -0.131
## R_hippocampus_ComputeArea
## R_hippocampus_Volume 0.399
## cerebellum_ComputeArea
## cerebellum_Volume -0.122 0.798
## L_lingual_gyrus_ComputeArea 0.115 0.169 -0.232
## L_lingual_gyrus_Volume
## R_lingual_gyrus_ComputeArea
## R_lingual_gyrus_Volume
## L_fusiform_gyrus_ComputeArea -0.188 -0.109
## L_fusiform_gyrus_Volume
## R_fusiform_gyrus_ComputeArea 0.166 0.424 -0.117
## R_fusiform_gyrus_Volume 0.605
## Sex 0.342 -0.149
## Weight 0.121 -0.424 -0.168
## Age -0.312
## Dx 0.368 -0.162 0.121
## chr12_rs34637584_GT -0.374 0.145 0.243 -0.118 0.213 -0.208
## chr17_rs11868035_GT -0.237 0.101 0.123
## UPDRS_part_I 0.310
## UPDRS_part_II 0.217 0.147
## UPDRS_part_III 0.603 -0.135
## Factor13 Factor14
## L_caudate_ComputeArea -0.196
## L_caudate_Volume -0.203
## R_caudate_ComputeArea 0.150
## R_caudate_Volume 0.195
## L_putamen_ComputeArea
## L_putamen_Volume 0.516
## R_putamen_ComputeArea
## R_putamen_Volume -0.112
## L_hippocampus_ComputeArea 0.130
## L_hippocampus_Volume 0.131 -0.158
## R_hippocampus_ComputeArea 0.442
## R_hippocampus_Volume 0.132
## cerebellum_ComputeArea
## cerebellum_Volume
## L_lingual_gyrus_ComputeArea 0.113 0.178
## L_lingual_gyrus_Volume -0.231
## R_lingual_gyrus_ComputeArea
## R_lingual_gyrus_Volume
## L_fusiform_gyrus_ComputeArea -0.133 0.360
## L_fusiform_gyrus_Volume
## R_fusiform_gyrus_ComputeArea -0.147
## R_fusiform_gyrus_Volume
## Sex
## Weight
## Age
## Dx
## chr12_rs34637584_GT
## chr17_rs11868035_GT 0.179
## UPDRS_part_I
## UPDRS_part_II -0.150
## UPDRS_part_III -0.110
##
## Factor1 Factor2 Factor3 Factor4 Factor5 Factor6 Factor7 Factor8
## SS loadings 1.060 1.055 1.048 1.029 1.028 0.875 0.784 0.776
## Proportion Var 0.034 0.034 0.034 0.033 0.033 0.028 0.025 0.025
## Cumulative Var 0.034 0.068 0.102 0.135 0.168 0.197 0.222 0.247
## Factor9 Factor10 Factor11 Factor12 Factor13 Factor14
## SS loadings 0.755 0.735 0.655 0.642 0.596 0.516
## Proportion Var 0.024 0.024 0.021 0.021 0.019 0.017
## Cumulative Var 0.271 0.295 0.316 0.337 0.356 0.373
##
## Test of the hypothesis that 14 factors are sufficient.
## The chi square statistic is 251.84 on 122 degrees of freedom.
## The p-value is 4.73e-11## P-value less than 0.05, reject null hypothesis that 2 factors are sufficient.
fit2<-factanal(pd, factors=19, rotation="varimax")
fit2##
## Call:
## factanal(x = pd, factors = 19, rotation = "varimax")
##
## Uniquenesses:
## L_caudate_ComputeArea L_caudate_Volume
## 0.840 0.005
## R_caudate_ComputeArea R_caudate_Volume
## 0.868 0.849
## L_putamen_ComputeArea L_putamen_Volume
## 0.791 0.702
## R_putamen_ComputeArea R_putamen_Volume
## 0.615 0.438
## L_hippocampus_ComputeArea L_hippocampus_Volume
## 0.476 0.777
## R_hippocampus_ComputeArea R_hippocampus_Volume
## 0.798 0.522
## cerebellum_ComputeArea cerebellum_Volume
## 0.137 0.504
## L_lingual_gyrus_ComputeArea L_lingual_gyrus_Volume
## 0.780 0.698
## R_lingual_gyrus_ComputeArea R_lingual_gyrus_Volume
## 0.005 0.005
## L_fusiform_gyrus_ComputeArea L_fusiform_gyrus_Volume
## 0.718 0.559
## R_fusiform_gyrus_ComputeArea R_fusiform_gyrus_Volume
## 0.663 0.261
## Sex Weight
## 0.829 0.005
## Age Dx
## 0.005 0.005
## chr12_rs34637584_GT chr17_rs11868035_GT
## 0.638 0.721
## UPDRS_part_I UPDRS_part_II
## 0.767 0.826
## UPDRS_part_III
## 0.616
##
## Loadings:
## Factor1 Factor2 Factor3 Factor4 Factor5 Factor6
## L_caudate_ComputeArea
## L_caudate_Volume 0.980
## R_caudate_ComputeArea
## R_caudate_Volume
## L_putamen_ComputeArea
## L_putamen_Volume
## R_putamen_ComputeArea
## R_putamen_Volume
## L_hippocampus_ComputeArea
## L_hippocampus_Volume
## R_hippocampus_ComputeArea -0.102
## R_hippocampus_Volume
## cerebellum_ComputeArea
## cerebellum_Volume
## L_lingual_gyrus_ComputeArea 0.107 0.106
## L_lingual_gyrus_Volume
## R_lingual_gyrus_ComputeArea 0.989
## R_lingual_gyrus_Volume 0.983
## L_fusiform_gyrus_ComputeArea
## L_fusiform_gyrus_Volume
## R_fusiform_gyrus_ComputeArea
## R_fusiform_gyrus_Volume
## Sex -0.111
## Weight 0.983
## Age 0.984
## Dx 0.965
## chr12_rs34637584_GT 0.124
## chr17_rs11868035_GT -0.303
## UPDRS_part_I -0.260
## UPDRS_part_II
## UPDRS_part_III 0.332 0.104
## Factor7 Factor8 Factor9 Factor10 Factor11 Factor12
## L_caudate_ComputeArea -0.101
## L_caudate_Volume
## R_caudate_ComputeArea
## R_caudate_Volume -0.103 -0.107 -0.182 0.174
## L_putamen_ComputeArea 0.299 -0.147
## L_putamen_Volume -0.123
## R_putamen_ComputeArea 0.147 -0.175 0.225
## R_putamen_Volume 0.698
## L_hippocampus_ComputeArea 0.708
## L_hippocampus_Volume
## R_hippocampus_ComputeArea
## R_hippocampus_Volume 0.652
## cerebellum_ComputeArea 0.920
## cerebellum_Volume 0.690
## L_lingual_gyrus_ComputeArea 0.143 -0.126
## L_lingual_gyrus_Volume
## R_lingual_gyrus_ComputeArea
## R_lingual_gyrus_Volume
## L_fusiform_gyrus_ComputeArea
## L_fusiform_gyrus_Volume
## R_fusiform_gyrus_ComputeArea 0.121
## R_fusiform_gyrus_Volume 0.844
## Sex
## Weight
## Age
## Dx
## chr12_rs34637584_GT -0.195 -0.207 0.197
## chr17_rs11868035_GT -0.165
## UPDRS_part_I -0.209 0.212 0.122
## UPDRS_part_II
## UPDRS_part_III -0.161 0.104
## Factor13 Factor14 Factor15 Factor16 Factor17
## L_caudate_ComputeArea 0.113 -0.119 -0.165
## L_caudate_Volume
## R_caudate_ComputeArea 0.174 -0.164
## R_caudate_Volume 0.125 0.120
## L_putamen_ComputeArea -0.165
## L_putamen_Volume 0.128 -0.149 0.382 -0.187
## R_putamen_ComputeArea 0.260 -0.218
## R_putamen_Volume -0.128
## L_hippocampus_ComputeArea
## L_hippocampus_Volume -0.106
## R_hippocampus_ComputeArea 0.331 0.181
## R_hippocampus_Volume -0.114
## cerebellum_ComputeArea
## cerebellum_Volume
## L_lingual_gyrus_ComputeArea 0.136 0.137 0.256
## L_lingual_gyrus_Volume
## R_lingual_gyrus_ComputeArea
## R_lingual_gyrus_Volume
## L_fusiform_gyrus_ComputeArea 0.493 -0.113
## L_fusiform_gyrus_Volume 0.646
## R_fusiform_gyrus_ComputeArea -0.544
## R_fusiform_gyrus_Volume
## Sex -0.352 -0.111
## Weight 0.106
## Age
## Dx 0.210
## chr12_rs34637584_GT 0.227 -0.289 0.186
## chr17_rs11868035_GT 0.168 -0.113 0.206
## UPDRS_part_I -0.123
## UPDRS_part_II 0.378
## UPDRS_part_III -0.121 -0.282 0.311
## Factor18 Factor19
## L_caudate_ComputeArea 0.237
## L_caudate_Volume
## R_caudate_ComputeArea -0.112
## R_caudate_Volume 0.113
## L_putamen_ComputeArea 0.164
## L_putamen_Volume -0.131
## R_putamen_ComputeArea -0.109 0.341
## R_putamen_Volume 0.110
## L_hippocampus_ComputeArea
## L_hippocampus_Volume -0.435
## R_hippocampus_ComputeArea
## R_hippocampus_Volume
## cerebellum_ComputeArea
## cerebellum_Volume
## L_lingual_gyrus_ComputeArea 0.140
## L_lingual_gyrus_Volume 0.536
## R_lingual_gyrus_ComputeArea
## R_lingual_gyrus_Volume
## L_fusiform_gyrus_ComputeArea
## L_fusiform_gyrus_Volume
## R_fusiform_gyrus_ComputeArea
## R_fusiform_gyrus_Volume
## Sex
## Weight
## Age
## Dx
## chr12_rs34637584_GT -0.152
## chr17_rs11868035_GT -0.175
## UPDRS_part_I 0.127
## UPDRS_part_II
## UPDRS_part_III
##
## Factor1 Factor2 Factor3 Factor4 Factor5 Factor6 Factor7 Factor8
## SS loadings 1.282 1.029 1.026 1.019 1.013 1.011 0.921 0.838
## Proportion Var 0.041 0.033 0.033 0.033 0.033 0.033 0.030 0.027
## Cumulative Var 0.041 0.075 0.108 0.140 0.173 0.206 0.235 0.263
## Factor9 Factor10 Factor11 Factor12 Factor13 Factor14 Factor15
## SS loadings 0.782 0.687 0.647 0.615 0.587 0.569 0.566
## Proportion Var 0.025 0.022 0.021 0.020 0.019 0.018 0.018
## Cumulative Var 0.288 0.310 0.331 0.351 0.370 0.388 0.406
## Factor16 Factor17 Factor18 Factor19
## SS loadings 0.547 0.507 0.475 0.456
## Proportion Var 0.018 0.016 0.015 0.015
## Cumulative Var 0.424 0.440 0.455 0.470
##
## Test of the hypothesis that 19 factors are sufficient.
## The chi square statistic is 54.51 on 47 degrees of freedom.
## The p-value is 0.211## P-value more than 0.05, failed to reject null hypothesis that 19 factors are sufficient. 19 factors are to be used. Variables with a high loading are well explained by the factor, positively or negatively.High uniqueness of variable does not account well for its variance.
cor(pd)[1:10, 1:10]## L_caudate_ComputeArea L_caudate_Volume
## L_caudate_ComputeArea 1.000000000 0.05794916
## L_caudate_Volume 0.057949162 1.00000000
## R_caudate_ComputeArea -0.060576361 0.01076372
## R_caudate_Volume 0.043994457 0.07245568
## L_putamen_ComputeArea 0.009640983 -0.06632813
## L_putamen_Volume -0.064299184 -0.11131525
## R_putamen_ComputeArea 0.040808105 0.04504867
## R_putamen_Volume 0.058552841 -0.11830387
## L_hippocampus_ComputeArea -0.037932760 -0.04443615
## L_hippocampus_Volume -0.042033469 -0.04680825
## R_caudate_ComputeArea R_caudate_Volume
## L_caudate_ComputeArea -0.060576361 0.043994457
## L_caudate_Volume 0.010763720 0.072455677
## R_caudate_ComputeArea 1.000000000 0.057441889
## R_caudate_Volume 0.057441889 1.000000000
## L_putamen_ComputeArea -0.015959528 -0.017003442
## L_putamen_Volume 0.063279351 0.021962691
## R_putamen_ComputeArea 0.078643479 0.054287467
## R_putamen_Volume 0.007022844 -0.094336376
## L_hippocampus_ComputeArea 0.051359613 0.006123355
## L_hippocampus_Volume 0.085788328 -0.077913614
## L_putamen_ComputeArea L_putamen_Volume
## L_caudate_ComputeArea 0.009640983 -0.06429918
## L_caudate_Volume -0.066328127 -0.11131525
## R_caudate_ComputeArea -0.015959528 0.06327935
## R_caudate_Volume -0.017003442 0.02196269
## L_putamen_ComputeArea 1.000000000 0.02228947
## L_putamen_Volume 0.022289469 1.00000000
## R_putamen_ComputeArea 0.090496109 0.09093926
## R_putamen_Volume 0.176353726 -0.05768765
## L_hippocampus_ComputeArea 0.094604791 0.02530330
## L_hippocampus_Volume -0.064425367 0.04041557
## R_putamen_ComputeArea R_putamen_Volume
## L_caudate_ComputeArea 0.04080810 0.058552841
## L_caudate_Volume 0.04504867 -0.118303868
## R_caudate_ComputeArea 0.07864348 0.007022844
## R_caudate_Volume 0.05428747 -0.094336376
## L_putamen_ComputeArea 0.09049611 0.176353726
## L_putamen_Volume 0.09093926 -0.057687648
## R_putamen_ComputeArea 1.00000000 0.052245264
## R_putamen_Volume 0.05224526 1.000000000
## L_hippocampus_ComputeArea -0.05508472 0.131800075
## L_hippocampus_Volume -0.08866344 -0.001133570
## L_hippocampus_ComputeArea L_hippocampus_Volume
## L_caudate_ComputeArea -0.037932760 -0.04203347
## L_caudate_Volume -0.044436146 -0.04680825
## R_caudate_ComputeArea 0.051359613 0.08578833
## R_caudate_Volume 0.006123355 -0.07791361
## L_putamen_ComputeArea 0.094604791 -0.06442537
## L_putamen_Volume 0.025303302 0.04041557
## R_putamen_ComputeArea -0.055084723 -0.08866344
## R_putamen_Volume 0.131800075 -0.00113357
## L_hippocampus_ComputeArea 1.000000000 -0.02633816
## L_hippocampus_Volume -0.026338163 1.00000000class <- pd$Dx
df <- as.data.frame(pd[1:5], class=class)
plot_ly(df) %>%
add_trace(type = 'splom', dimensions = list( list(label=colnames(pd)[1], values=~L_caudate_ComputeArea),
list(label=colnames(pd)[2], values=~L_caudate_Volume),
list(label=colnames(pd)[3], values=~R_caudate_ComputeArea),
list(label=colnames(pd)[4], values=~R_caudate_Volume),
list(label=colnames(pd)[5], values=~L_putamen_ComputeArea)),
text=~class, marker = list(line = list(width = 1, color = 'rgb(230,230,230)'))) %>%
layout(title= 'Parkinsons Disease (PD) Data Pairs Plot', hovermode='closest', dragmode= 'select',
plot_bgcolor='rgba(240,240,240, 0.95)')# No relationship found among the 5 selected variables.2 Allometric Relations in Plants example
2.1 Load data
Load Allometric Relations in Plants data and perform proper type conversion, e.g., convert “Province” and “Born”.
library(xml2)
library(rvest)
library(ggplot2)
library(dplyr)##
## Attaching package: 'dplyr'## The following objects are masked from 'package:stats':
##
## filter, lag## The following objects are masked from 'package:base':
##
## intersect, setdiff, setequal, unionplt<-read_html('https://wiki.socr.umich.edu/index.php/SOCR_Data_Dinov_032708_AllometricPlanRels')
html_nodes(plt, "#content")## {xml_nodeset (1)}
## [1] <div id="content" class="mw-body" role="main">\n\t\t\t<a id="top"></a>\n\ ...plt<- as.data.frame(rbind(html_table(html_nodes(plt, "table")[[1]]),html_table(html_nodes(plt, "table")[[2]]),html_table(html_nodes(plt, "table")[[3]]),html_table(html_nodes(plt, "table")[[4]]),html_table(html_nodes(plt, "table")[[5]]),html_table(html_nodes(plt, "table")[[6]]),html_table(html_nodes(plt, "table")[[7]])))
library(mi)## Loading required package: Matrix## Loading required package: stats4## mi (Version 1.1, packaged: 2022-06-05 05:31:15 UTC; ben)## mi Copyright (C) 2008, 2009, 2010, 2011, 2012, 2013, 2014, 2015 Trustees of Columbia University## This program comes with ABSOLUTELY NO WARRANTY.## This is free software, and you are welcome to redistribute it## under the General Public License version 2 or later.## Execute RShowDoc('COPYING') for details.mdf<-missing_data.frame(plt)
show(mdf)## Object of class missing_data.frame with 694 observations on 8 variables
##
## There are 2 missing data patterns
##
## Append '@patterns' to this missing_data.frame to access the corresponding pattern for every observation or perhaps use table()
##
## type missing method model
## Province/Sites unordered-categorical 0 <NA> <NA>
## Alt.(m) continuous 0 <NA> <NA>
## Long.(E,deg.) continuous 0 <NA> <NA>
## Lat.(N,deg.) continuous 0 <NA> <NA>
## Born binary 0 <NA> <NA>
## L(g/no.) continuous 0 <NA> <NA>
## M(g/no.) continuous 0 <NA> <NA>
## D(no./m2) continuous 1 ppd linear
##
## family link transformation
## Province/Sites <NA> <NA> <NA>
## Alt.(m) <NA> <NA> standardize
## Long.(E,deg.) <NA> <NA> standardize
## Lat.(N,deg.) <NA> <NA> standardize
## Born <NA> <NA> <NA>
## L(g/no.) <NA> <NA> standardize
## M(g/no.) <NA> <NA> standardize
## D(no./m2) gaussian identity standardizemdf<-change(mdf, y=c("D(no./m2)") , what = "imputation_method", to="pmm")
imputations<-mi(mdf, n.iter=10, n.chains=3, verbose=T)
plt <- complete(imputations, 3)
plt<-plt$`chain:3`
plt<-plt[,-9]%>%mutate_at(c(1,5),as.factor)%>%mutate_at(c(1,5),as.integer)
str(plt)## 'data.frame': 694 obs. of 8 variables:
## $ Province.Sites: int 6 6 6 6 6 6 6 6 8 8 ...
## $ Alt..m. : num 800 550 441 590 800 590 876 500 880 900 ...
## $ Long..E.deg.. : num 129 125 127 132 130 ...
## $ Lat..N.deg.. : num 44.3 52.3 51.7 46.5 44.1 ...
## $ Born : int 1 1 1 1 1 1 1 1 1 1 ...
## $ L.g.no.. : num 17538 9313 2570 13939 14375 ...
## $ M.g.no.. : num 610990 298385 82175 422030 450643 ...
## $ D.no..m2. : num 0.0394 0.0291 0.114 0.033 0.0544 ...2.2 Apply Principal Component Analysis:
Generate a data summary
summary(plt)## Province.Sites Alt..m. Long..E.deg.. Lat..N.deg.. Born ## Min. : 1.00 Min. : 150 Min. : 81.1 Min. :25.75 Min. :1.000 ## 1st Qu.:10.00 1st Qu.:1150 1st Qu.:105.0 1st Qu.:34.34 1st Qu.:1.000 ## Median :14.00 Median :1620 Median :111.8 Median :37.05 Median :1.000 ## Mean :12.73 Mean :1789 Mean :111.8 Mean :37.90 Mean :1.013 ## 3rd Qu.:14.75 3rd Qu.:2248 3rd Qu.:113.6 3rd Qu.:40.70 3rd Qu.:1.000 ## Max. :18.00 Max. :4240 Max. :134.0 Max. :53.00 Max. :2.000 ## L.g.no.. M.g.no.. D.no..m2. ## Min. : 143.2 Min. : 3841 Min. :0.01250 ## 1st Qu.: 3621.0 1st Qu.: 60361 1st Qu.:0.05452 ## Median : 6903.1 Median : 111314 Median :0.08230 ## Mean : 9530.5 Mean : 240227 Mean :0.12261 ## 3rd Qu.: 13308.2 3rd Qu.: 289687 3rd Qu.:0.13603 ## Max. :225116.3 Max. :9107791 Max. :2.05350Apply
factoextraand compare it to the results ofprcomplibrary(factoextra) plt1<-prcomp(as.matrix(plt), center = T) summary(plt1)## Importance of components: ## PC1 PC2 PC3 PC4 PC5 PC6 PC7 PC8 ## Standard deviation 4.569e+05 5.44e+03 928.6 6.283 3.76 1.942 0.1453 0.1104 ## Proportion of Variance 9.999e-01 1.40e-04 0.0 0.000 0.00 0.000 0.0000 0.0000 ## Cumulative Proportion 9.999e-01 1.00e+00 1.0 1.000 1.00 1.000 1.0000 1.0000get_eigenvalue(plt1)## eigenvalue variance.percent cumulative.variance.percent ## Dim.1 2.087243e+11 9.998541e+01 99.98541 ## Dim.2 2.959677e+07 1.417777e-02 99.99959 ## Dim.3 8.622529e+05 4.130458e-04 100.00000 ## Dim.4 3.948176e+01 1.891298e-08 100.00000 ## Dim.5 1.413471e+01 6.770962e-09 100.00000 ## Dim.6 3.772931e+00 1.807350e-09 100.00000 ## Dim.7 2.111185e-02 1.011323e-11 100.00000 ## Dim.8 1.217779e-02 5.833537e-12 100.00000##They are similar in term of variance and cumulative variance but in proportion and percent respectively.Additionally, "factoextra"shows the eigenvalue.Report the rotations (scores)
plt1$rotation## PC1 PC2 PC3 PC4 ## Province.Sites 1.489149e-06 -7.870210e-05 -2.499058e-03 -2.703875e-01 ## Alt..m. 6.944255e-04 -2.494983e-02 -9.996452e-01 8.935353e-03 ## Long..E.deg.. -6.258121e-06 3.271568e-04 7.839470e-03 9.410573e-01 ## Lat..N.deg.. -3.197330e-06 2.367217e-05 4.316158e-03 2.030273e-01 ## Born -1.165447e-08 4.785827e-07 1.942249e-05 1.215124e-03 ## L.g.no.. 2.233423e-02 -9.994389e-01 2.496090e-02 1.110449e-04 ## M.g.no.. 9.997503e-01 2.234460e-02 1.367973e-04 -1.744457e-06 ## D.no..m2. -7.580691e-08 5.510150e-06 2.652073e-05 -5.283474e-04 ## PC5 PC6 PC7 PC8 ## Province.Sites -1.583827e-01 9.496255e-01 8.979166e-04 -3.158606e-03 ## Alt..m. 2.543382e-03 3.355664e-04 9.425943e-06 -9.144817e-06 ## Long..E.deg.. -2.515095e-01 2.260213e-01 2.472332e-03 8.766594e-04 ## Lat..N.deg.. 9.547613e-01 2.170602e-01 -8.547509e-03 -1.973189e-03 ## Born -3.071932e-04 -3.132589e-03 1.434681e-01 -9.896492e-01 ## L.g.no.. -1.106319e-04 -4.013636e-06 5.823878e-06 1.033963e-06 ## M.g.no.. 2.420541e-06 5.511328e-07 -7.313822e-08 -1.352364e-08 ## D.no..m2. 9.063034e-03 9.026379e-04 9.896145e-01 1.434568e-01Show the scree plot
plot_ly(x = c(1:length(plt1$sdev)), y = plt1$sdev*plt1$sdev, name = "Scree", type = "bar") %>% layout(title="Scree Plot", xaxis = list(title="PC's"), yaxis = list(title="Variances (SD^2)"))Select the number of PCs and employ a bootstrap test
scores <- plt1$x loadings <- plt1$rotation scaleLoad <- 10 p <- plot_ly(plt) %>% add_trace(x=scores[,2], y=scores[,3], z=scores[,4], type="scatter3d", mode="markers", name="", marker = list(color=plt[,1], colorscale = c("#FFE1A1", "#683531"), opacity = 0.7)) for (k in 1:ncol(loadings)) { x <- c(0, loadings[8, k])*scaleLoad y <- c(0, loadings[7, k])*scaleLoad z <- c(0, loadings[6, k])*scaleLoad p <- p %>% add_trace(x=x, y=y, z=z, type="scatter3d", mode="lines", name=paste0("Loading PC ", k, " ", colnames(plt)[k]), line=list(width=8), opacity=1) } p <- p %>% layout(legend = list(orientation = 'h'), title="3D Projection of 6D Data along First 3 PCs", scene = list ( xaxis = list(title = rownames(loadings)[8]), yaxis = list(title = rownames(loadings)[7]), zaxis = list(title = rownames(loadings)[6]))) p# both scree plot and 3D Scatterplot resulted in only one factor. num_boot = 1000 bootstrap_it = function(i) { data_resample = plt[sample(1:nrow(plt), nrow(plt), replace=TRUE),] p_resample = princomp(data_resample,cor = T) return(sum(p_resample$sdev[1:3]^2)/sum(p_resample$sdev^2)) } pco = data.frame(per=sapply(1:num_boot, bootstrap_it)) quantile(pco$per, probs = c(0.025,0.975))## 2.5% 97.5% ## 0.7633534 0.8014338plot_ly(x = pco$per, type = "histogram", name = "Data Histogram") %>% layout(title='Histogram of a Bootstrap Simulation <br /> Percent of Data Variability Captured by first 3 PCs', xaxis = list(title = "Percent of Variability"), yaxis = list(title = "Frequency Count"), bargap=0.1)#CI(95%) = (0.763,0.802)Perform SVD and ICA and compare the results of PCA.
- Use these three variables “L”,“M”,“D” to perform ICA and show
pair-plots of before-ICA and after-ICA scatter in the data.
scatter3dplot()may be helpful, which you saw in Chapter 4
zvars<-scale(plt) z.svd<-svd(zvars) z.svd$d/sqrt(nrow(plt)-1)## [1] 1.9245494 1.2499831 0.9869642 0.9274467 0.6005291 0.5308719 0.3864064 ## [8] 0.3280643z.svd$v## [,1] [,2] [,3] [,4] [,5] [,6] ## [1,] 0.4218752 -0.2899595 -0.09337734 0.05574536 0.47099467 -0.5693923102 ## [2,] 0.4549640 -0.1698082 -0.09182550 0.02525678 -0.22123428 0.6526057654 ## [3,] -0.4502663 0.2089038 0.12365301 -0.12773157 -0.39643098 -0.2939384467 ## [4,] -0.4226654 0.2179969 0.07221768 0.16156935 0.71447648 0.3744330449 ## [5,] -0.1229859 0.1126755 -0.88974217 -0.41967231 0.06214946 0.0169885407 ## [6,] 0.3035750 0.6104180 -0.03299552 0.14205209 0.10395439 0.0005771077 ## [7,] 0.2890584 0.6165670 -0.05683920 0.19547456 -0.12255895 -0.1406160145 ## [8,] -0.2068943 -0.1745407 -0.40790043 0.84812770 -0.17859307 -0.0568892737 ## [,7] [,8] ## [1,] -0.424222557 -0.01046694 ## [2,] -0.529012385 -0.02025023 ## [3,] -0.682894354 0.11005460 ## [4,] -0.269909264 -0.13778078 ## [5,] -0.012160076 -0.01066173 ## [6,] 0.007739487 0.70929393 ## [7,] -0.026385790 -0.67776074 ## [8,] -0.009023904 0.07624725plt3<-princomp(plt, cor=T) plt3## Call: ## princomp(x = plt, cor = T) ## ## Standard deviations: ## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8 ## 1.9245494 1.2499831 0.9869642 0.9274467 0.6005291 0.5308719 0.3864064 0.3280643 ## ## 8 variables and 694 observations.loadings(plt3)## ## Loadings: ## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8 ## Province.Sites 0.422 0.290 0.471 0.569 0.424 ## Alt..m. 0.455 0.170 -0.221 -0.653 0.529 ## Long..E.deg.. -0.450 -0.209 -0.124 -0.128 -0.396 0.294 0.683 -0.110 ## Lat..N.deg.. -0.423 -0.218 0.162 0.714 -0.374 0.270 0.138 ## Born -0.123 -0.113 0.890 -0.420 ## L.g.no.. 0.304 -0.610 0.142 0.104 -0.709 ## M.g.no.. 0.289 -0.617 0.195 -0.123 0.141 0.678 ## D.no..m2. -0.207 0.175 0.408 0.848 -0.179 ## ## Comp.1 Comp.2 Comp.3 Comp.4 Comp.5 Comp.6 Comp.7 Comp.8 ## SS loadings 1.000 1.000 1.000 1.000 1.000 1.000 1.000 1.000 ## Proportion Var 0.125 0.125 0.125 0.125 0.125 0.125 0.125 0.125 ## Cumulative Var 0.125 0.250 0.375 0.500 0.625 0.750 0.875 1.000## ##Comp.1,5, 6,7: High loadings for Province, Latitute, Longitude & Atitude with slight variant. ##Comp.2 & 8: High Loading for L & M with slight variant. ##Comp.3 & 4: High Loading for Born & D with slight variant. S <- matrix(runif(10000), 5000, 2) A <- matrix(c(1, 1, -1, 3), 2, 2, byrow = TRUE) X <- S %*% A cor(X)## [,1] [,2] ## [1,] 1.0000000 -0.4443388 ## [2,] -0.4443388 1.0000000#The correlation between the two variables is -0.4. library(fastICA) a <- fastICA(plt[,6:8], 2, alg.typ = "parallel", fun = "logcosh", alpha = 1, method = "C", row.norm = FALSE, maxit = 200, tol = 0.0001) plot_ly() %>% add_markers(x = a$X[ , 1], y =~a$X[ , 2], name="Pre-processed data", marker = list(color="green", opacity=0.9, symbol=105)) %>% add_markers(x = a$S[ , 1], y = a$S[ , 2], name="ICA components", marker = list(color="blue", opacity=0.99, symbol=5)) %>% layout(title='Scatter Plots of the Original (Pre-processed) Data and the corresponding ICA Transform', xaxis = list(title="Twin 1 (standardized height)"), yaxis = list(title="Twin 2 (standardized height)"), legend = list(orientation = 'h'))#ICA Component is more concentric than the scattered pre-processed data, indicating higher precision and accurracy in the origin. The pre-processed data radial toward first quadrant form third quadrant. library(scatterplot3d) scatterplot3d(scale(a$X[,1]), scale(a$X[,2]), scale(a$X[,3]))
# The value is concentrated over at lower end of L & D with M between the range of 0 to 5. cor(a$X)## [,1] [,2] [,3] ## [1,] 1.0000000 0.8823959 -0.2832561 ## [2,] 0.8823959 1.0000000 -0.2198456 ## [3,] -0.2832561 -0.2198456 1.0000000# The correlation between the 3 variables 0.882(LvsM), -0.283(LvsD) and -0.220 (MvsD) cor(a$S)## [,1] [,2] ## [1,] 1.000000e+00 4.072814e-14 ## [2,] 4.072814e-14 1.000000e+00# Dimensions were reduced from 3 variables to 2 components. The correlation of two components is nearly 0.- Use these three variables “L”,“M”,“D” to perform ICA and show
pair-plots of before-ICA and after-ICA scatter in the data.
Perform factor analysis
- Use
require(nFactors)to determine the number of the factors and show a scree plot as stated in notes;
ev <- eigen(cor(plt)) # get eigenvalues ap <- parallel(subject=nrow(plt), var=ncol(plt), rep=100, cent=.05) plt2 <- nScree(x=ev$values, aparallel=ap$eigen$qevpea) summary(plt2)## Report For a nScree Class ## ## Details: components ## ## Eigenvalues Prop Cumu Par.Analysis Pred.eig OC Acc.factor AF ## 1 4 0 0 1 2 NA (< AF) ## 2 2 0 1 1 1 (< OC) 2 ## 3 1 0 1 1 1 0 ## 4 1 0 1 1 0 0 ## 5 0 0 1 1 0 0 ## 6 0 0 1 1 0 0 ## 7 0 0 1 1 NA 0 ## 8 0 0 1 1 NA NA ## ## ## Number of factors retained by index ## ## noc naf nparallel nkaiser ## 1 2 1 2 2plotnScree(plt2)
# Number of factor is 2 in 3 out of 4 Cattell’s Scree test rules.- Use
factanal()to apply FA and compare the rotation “varimax” and “promax”
fit3<-factanal(plt, 2, rotation="varimax");fit3## ## Call: ## factanal(x = plt, factors = 2, rotation = "varimax") ## ## Uniquenesses: ## Province.Sites Alt..m. Long..E.deg.. Lat..N.deg.. Born ## 0.280 0.234 0.184 0.378 0.963 ## L.g.no.. M.g.no.. D.no..m2. ## 0.005 0.218 0.893 ## ## Loadings: ## Factor1 Factor2 ## Province.Sites -0.840 0.123 ## Alt..m. -0.840 0.246 ## Long..E.deg.. 0.874 -0.230 ## Lat..N.deg.. 0.775 -0.143 ## Born 0.189 ## L.g.no.. -0.121 0.990 ## M.g.no.. -0.113 0.877 ## D.no..m2. 0.197 -0.261 ## ## Factor1 Factor2 ## SS loadings 2.877 1.968 ## Proportion Var 0.360 0.246 ## Cumulative Var 0.360 0.606 ## ## Test of the hypothesis that 2 factors are sufficient. ## The chi square statistic is 161.47 on 13 degrees of freedom. ## The p-value is 9.94e-28fit4<-factanal(plt, 2, rotation="promax");fit4## ## Call: ## factanal(x = plt, factors = 2, rotation = "promax") ## ## Uniquenesses: ## Province.Sites Alt..m. Long..E.deg.. Lat..N.deg.. Born ## 0.280 0.234 0.184 0.378 0.963 ## L.g.no.. M.g.no.. D.no..m2. ## 0.005 0.218 0.893 ## ## Loadings: ## Factor1 Factor2 ## Province.Sites -0.873 ## Alt..m. -0.855 ## Long..E.deg.. 0.893 ## Lat..N.deg.. 0.802 ## Born 0.197 ## L.g.no.. 1.003 ## M.g.no.. 0.887 ## D.no..m2. 0.171 -0.225 ## ## Factor1 Factor2 ## SS loadings 3.002 1.855 ## Proportion Var 0.375 0.232 ## Cumulative Var 0.375 0.607 ## ## Factor Correlations: ## Factor1 Factor2 ## Factor1 1.000 -0.358 ## Factor2 -0.358 1.000 ## ## Test of the hypothesis that 2 factors are sufficient. ## The chi square statistic is 161.47 on 13 degrees of freedom. ## The p-value is 9.94e-28# The two rotations share the same uniqueness value. # Promax resulted in higher loadings than varimax # Promax omitted lesser loadings as compared to varimax. # Varimax resulted in lower variance and SS Loading. # P-value remain the same for both rotation. # P-value less than 0.05, reject null hypothesis that 2 factors are sufficient. # Varimax assume no correlation between factors whereas promax has significant correlation. # Promax include factor correlation, with factor correlation of -0.36.- Report the loadings and consider an appropriate visualization method
## Factor1: High Loadings for Provinces, Atitude, Latitude & Longtitude ## Factor2: High Loadings for L & M #Varimax load <- fit3$loadings df <- as.data.frame(load[]) Features <- rownames(df) X <- df$Factor1 Y <- df$Factor2 df1 <- data.frame(Features, X, Y) cols <- palette(rainbow(6)) cols <- cols[1:8] plot_ly(df1, x = ~X, y = ~Y, text = ~Features, color = cols) %>% add_markers(marker = list(opacity=0.99, size=20, color=cols, symbol=~as.numeric(as.factor(Features)))) %>% add_text(textfont = list(family= "Times", size= 20, color= cols), textposition="top right") %>% layout(title = '2D FA', xaxis = list(title = 'Factor 1', zeroline = TRUE,range = c(-1, 1)), yaxis = list(title = 'Factor 2'), showlegend = FALSE)#Varimax resulted in L & M with high and positive loadings of Factor 2 with negative loadings of Factor 1. Born & D are positive loaded in Factor 1 but negative loaded in Factor 2. Latitutde and Longitude have high and positive loadings of Factor 1 with negative loadings of Factor 2. Province and Altitude have high and negative loadings of Factor 1 with positive loadings of Factor 2 #Promax load <- fit4$loadings df <- as.data.frame(load[]) Features <- rownames(df) X <- df$Factor1 Y <- df$Factor2 df1 <- data.frame(Features, X, Y) cols <- palette(rainbow(6)) cols <- cols[1:8] plot_ly(df1, x = ~X, y = ~Y, text = ~Features, color = cols) %>% add_markers(marker = list(opacity=0.99, size=20, color=cols, symbol=~as.numeric(as.factor(Features)))) %>% add_text(textfont = list(family= "Times", size= 20, color= cols), textposition="top right") %>% layout(title = '2D FA', xaxis = list(title = 'Factor 1', zeroline = TRUE,range = c(-1, 1)), yaxis = list(title = 'Factor 2'), showlegend = FALSE)## Overall, the loadings are not significant difference when compared with Varimax. However, Promax resulted in as L & M moving to the zero of Factor 1 (X- Axis) whereas D, Altitude, and Longitude moving toward the zero of Factor 2 (Y-axis). Province, Latitude and Born are transformed to different (+/-) relationship/association of Factor 2(Y-axis) under Promax.- Use
Interpret the findings in the context of the case-study.
##PCA
##Both scree plot and 3D Scatterplot resulted in only one factor.
##The Confidence Interval (95%) has a limits of ~0.765 & ~0.803.
##SVD
##The proportion variance are decomposed into single value of equal split between variables that summed up to 100%. The SS loadings is equal to 1 as a result of equal SD. The Loadings generated are based on the assumed equal variance. The high value of loadings is well explained by the components (between -1 to 1).
##Comp.1,5, 6,7: High loadings for Province, Latitute, Longitude & Atitude with variant.
##Comp.2 & 8: High Loading for L & M with variant.
##Comp.3 & 4: High Loading for Born & D with variant.
##ICA
##The correlation between two variables of default X is -0.4.
##ICA Component is more concentric than the scattered pre-processed data, indicating higher precision and accurracy in the origin. The pre-processed data radial toward first quadrant form third quadrant.
### The scatterplot shows that the values are concentrated over at lower end of L & D with M between the range of 0 to 5.
##The correlation between the selected 3 variables 0.882(LvsM), -0.283(LvsD) and -0.220 (MvsD)
##Dimensions were reduced from 3 variables to 2 components. The correlation of two components is nearly 0.
##FA
##Number of factor is 2 in 3 out of 4 Cattell’s Scree test rules.
##The two rotations (Varimax vs Promax) share the same uniqueness value.
##Promax resulted in higher loadings than varimax
##Promax omitted lesser loadings as compared to varimax.
##Varimax resulted in lower variance and SS Loading.
##P-value remain the same for both rotation.
##P-value less than 0.05, reject null hypothesis that 2 factors are sufficient.
##Varimax assume no correlation between factors whereas promax has significant correlation.
##Promax include factor correlation, with factor correlation of -0.36.
##Factor1: High Loadings for Provinces, Atitude, Latitude & Longtitude
##Factor2: High Loadings for L & M
##Varimax resulted in L & M with high and positive loadings of Factor 2 with negative loadings of Factor 1. Born & D are positive loaded in Factor 1 but negative loaded in Factor 2. Latitutde and Longitude have high and positive loadings of Factor 1 with negative loadings of Factor 2. Province and Altitude have high and negative loadings of Factor 1 with positive loadings of Factor 2
## Overall, the loadings are not significant difference when compared with Varimax. However, Promax resulted in as L & M moving to the zero of Factor 1 (X- Axis) whereas D, Altitude, and Longitude moving toward the zero of Factor 2 (Y-axis). Province, Latitude and Born are transformed to different (+/-) relationship/association of Factor 2(Y-axis) under Promax.